17

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)?

Community
  • 1
  • 1
nilo de roock
  • 4,077
  • 4
  • 34
  • 62

1 Answers1

14

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]
]
Heike
  • 24,102
  • 2
  • 31
  • 45
  • 1
    "It shouldn't be too hard to introduce a third dimensions by adding modifier keys."- For me it is, I am afraid. – nilo de roock Dec 06 '11 at 09:58
  • Wow, it works better than I thought from looking at the code. :-) – nilo de roock Dec 06 '11 at 09:59
  • When you move a Cuboid entirely to the left ( or right ) they disappear and recovery doesn't seem to be possible. That's a bit nasty. – nilo de roock Dec 06 '11 at 10:02
  • @nilo Thanks (I think). I'll see what I can do about the objects moving out of the box. There's a lot of code duplication so that could be streamlined as well. – Heike Dec 06 '11 at 10:09
  • Thank you, @Heike. If that disappearing could be solved it is a very nice solution indeed! – nilo de roock Dec 06 '11 at 10:38
  • 2
    Wow! What a powerful effect from such a small bit of code, well-done! – Daniel Chisholm Dec 06 '11 at 12:33
  • Very nice. I hope the folks at WRI take a look (and perhaps make some comments). – DavidC Dec 06 '11 at 13:18
  • You could use PlotRange->All then the movement of the boxes where to rescale the bounding box and they could not move out of that. Not sure if this is what you want though. –  Dec 06 '11 at 16:12
  • I get an `"Affine transform pos1$6570 should be one of the forms {{{xx, yx, zx}, {xy, yy, zy}, {xz, yz, zz}}, {tx, ty, tz}}; {{xx, yx, zx}, {xy, yy, zy}, {xz, yz, zz}}; or {tx, ty, tz}."` error with your updated code. Probably something small somewhere with the copy-pasta, but I don't have time to look through now... just letting you know. – abcd Dec 06 '11 at 22:01
  • @yoda: Strange, the code as posted works for me, even in a fresh session. What version are you using (I'm on 8.0.1)? – Heike Dec 06 '11 at 22:13
  • @Heike Mine is "8.0 for Mac OS X x86 (64-bit) (February 23, 2011)". I wouldn't be surprised about bugs between these minor releases. See the comments under [this answer](http://dsp.stackexchange.com/a/682/77) for another example of changes between minor versions. Not sure what the reason is, in this case though. – abcd Dec 06 '11 at 22:25
  • @yoda That's the same version as mine. Judging from the error, it looks like `pos1` when `generate` was called didn't get initiated which should have happened in the line `pos1=pos`. The only thing I can think of right now is that either that line or the semicolon at the end of the previous line got lost somewhere. – Heike Dec 06 '11 at 22:43
  • @Heike code as posted works fine here, same version of Mathematica as yours. It's nice code... – cormullion Dec 06 '11 at 23:30