wolfram-mathematica - una - unir dos graficas en mathematica

¿Cómo puedo seleccionar uno de varios objetos de Graphics3D y cambiar sus coordenadas en Mathematica?

Question

En la respuesta aceptada de la pregunta " Mathematica y MouseListener: desarrollar gráficos interactivos con Mma ", Sjoerd C de Vries demuestra que es posible seleccionar un objeto en un gráfico 3D y cambiar su color.

Me gustaría saber si es posible (de una manera similar a la anterior) en un Graphics3D con dos o más objetos (por ejemplo, dos cuboides) para seleccionar uno y cambiar sus coordenadas (moviéndolo o de otra manera).

Answer 1

Estoy reutilizando parcialmente el código de Sjoerd aquí, pero tal vez algo como esto

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

Tenga en cuenta que esto solo mueve los cuboides en un plano, por lo que tendría que rotar el cuadro delimitador para moverlos perpendiculares a ese plano, pero no debería ser demasiado difícil introducir una tercera dimensión agregando teclas modificadoras.

Editar

Gracias por los comentarios. Aquí hay una versión actualizada del código anterior. En esta versión, los cubos saltan hacia atrás dentro del cuadro delimitador si se mueven hacia afuera, de modo que eso debería resolver el problema de los cubos que desaparecen.

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