Как выбрать один из нескольких объектов Graphics3D и изменить его координаты в Mathematica?

Question

В принятом ответе на вопрос « Mathematica и MouseListener - разработка интерактивной графики с помощью Mma » Сьорд К. де Врис демонстрирует, что можно выделить объект в 3D-графике и изменить его цвет.

Я хотел бы знать, возможно ли (таким же образом, как описано выше) в Graphics3D с двумя или более объектами (например, двумя кубоидами) выбрать один и изменить его координаты (путем перемещения или иным образом)?

Answer 1

Я частично повторно использую здесь код Sjoerd, но, может быть, что-то вроде этого

DynamicModule[{pos10, pos11 = {0, 0, 0}, 
  pos12 = {0, 0, 0}, pos20, pos21 = {0, 0, 0}, pos22 = {0, 0, 0}}, 
 Graphics3D[{EventHandler[
    Dynamic[{Translate[Cuboid[], pos11]}, ImageSize -> Tiny], 
   {"MouseDown" :> (pos10 = Mean@MousePosition["Graphics3DBoxIntercepts"]),
    "MouseDragged" :> (pos11 = 
      pos12 + Mean@MousePosition["Graphics3DBoxIntercepts"] - pos10),
    "MouseUp" :> (pos12 = pos11)}], 
  EventHandler[
   Dynamic[{Translate[Cuboid[{1, 1, 1}], pos21]}, ImageSize -> Tiny], 
   {"MouseDown" :> (pos20 = Mean@MousePosition["Graphics3DBoxIntercepts"]),
    "MouseDragged" :> (pos21 = 
       pos22 + Mean@MousePosition["Graphics3DBoxIntercepts"] - pos20),
    "MouseUp" :> (pos22 = pos21)}]},
  PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}]]

Обратите внимание, что это просто перемещает кубоиды в плоскости, поэтому вам нужно будет повернуть ограничивающий прямоугольник, чтобы переместить их перпендикулярно этой плоскости, но не должно быть слишком сложно ввести третье измерение, добавив клавиши-модификаторы.

---

Редактировать

Спасибо за комментарии. Вот обновленная версия кода выше. В этой версии кубы перепрыгивают обратно в ограничивающий прямоугольник, если им случается перемещаться наружу, что должно решить проблему исчезающих кубов.

DynamicModule[{init, cube, bb, restrict, generate},
 init = {{0, 0, 0}, {2, 1, 0}};
 bb = {{-3, 3}, {-3, 3}, {-3, 3}};
 cube[pt_, scale_] := 
  Translate[Scale[Cuboid[{-1/2, -1/2, -1/2}, {1/2, 1/2, 1/2}], scale], pt];
 restrict[pt_] := MapThread[Min[Max[#1[[1]], #2], #1[[2]]] &, {bb, pt}];
 generate[pos_, scale_] := Module[{mp, pos0, pos1, pos2},
   mp := MousePosition["Graphics3DBoxIntercepts"];
   pos1 = pos;
   EventHandler[
    Dynamic[{cube[pos1, scale]}, ImageSize -> Tiny], 
    {"MouseDown" :> (pos0 = LeastSquares[Transpose[mp], pos1].mp), 
     "MouseDragged" :> 
       ((pos1 = #[[2]] + Projection[pos0 - #[[2]], #[[1]] - #[[2]]]) &@mp),
     "MouseUp" :> (pos1 = restrict[pos1])}]];

 Graphics3D[generate[#, 1] & /@ init, PlotRange -> bb, PlotRangePadding -> .5]
]