Question

In the accepted answer of question ” Mathematica and MouseListener – developing interactive graphics with Mma ” Sjoerd C de Vries demonstrates that it is possible to select an object in a 3D graphic and change its color.

I would like to know if it is possible (in a similar fashion as above) in a Graphics3D with two or more objects (e.g. two cuboids) to select one and change its coordinates (by moving or otherwise)?

Answer 1

I’m partly reusing Sjoerd’s code here, but maybe something like this

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}}]]

Note that this just moves the cuboids in a plane so you would have to rotate the bounding box to move them perpendicular to that plane, but it shouldn’t be too hard to introduce a third dimensions by adding modifier keys.

---

Edit

Thanks for the comments. Here’s an updated version of the code above. In this version the cubes jump back to within the bounding box if they happen to move outside so that should solve the problem of the disappearing cubes.

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]
]