Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

When doing presentation with Mathematica, I often want a 3D plot to rotate automatically, so the 3D feeling is stronger. I don't want to drag the mouse very time.

So, I want a general function like

autoRotate["3D graphics here"]

The out put is a rotating version, and I can stop/start the rotation by click a control.

Question: How can I implement this function efficiently so the rotation is as smooth as possible?

Here is my first try: Get viewpoint and compute the rotation matrix;

g = Plot3D[Sin[x y], {x, 0, 3}, {y, 0, 3}];
vc = AbsoluteOptions[g, ViewCenter][[1, 2]];
vp = AbsoluteOptions[g, ViewPoint][[1, 2]];
m = RotationMatrix[3 Degree, {0., 0., 1.}];
newvp = m.(vp - vc);

then manipulate:

Manipulate[If[start, newvp = m.newvp]; 
 Show[g, ViewPoint -> Dynamic[newvp + vc], 
  SphericalRegion -> True ], {start, {False, True }}]

This seems slow and I lose the ability to zoom/rotate the plot manually.

Second try:

DynamicModule[{}, 
   Show[g, ViewPoint -> 
   Dynamic[newvp = m.newvp; newvp + vc, UpdateInterval -> 1.], 
  SphericalRegion -> True ]]

This seems faster, but I can't control the refreshrate. UpdateInterval ->1 seems to lose effect and I also can't zoom/rotate the plot manually.

Update: Based on Rojo's idea and Silvia's comment, here is what I currently use:

autoRotate[gr_Graphics3D, rate_: 7] := 
 DynamicModule[{vp, va, vv, vc }, {vp, va, vv, vc} = 
   gr~AbsoluteOptions~#~OptionValue~# &@{ViewPoint, ViewAngle, 
     ViewVertical, ViewCenter};
  Overlay[{Show[Graphics3D[], ViewPoint -> Dynamic[vp],
     ViewAngle -> Dynamic[va], SphericalRegion -> True], 
    Show[gr, SphericalRegion -> True, 
     ViewPoint -> Dynamic[RotationMatrix[Clock[2 \[Pi], rate], vv].vp],
     ViewAngle -> Dynamic[va], Boxed -> False , Axes -> False]}, All, 
   1]]
share|improve this question
    
Boxed -> False, Axes -> False will make things smoother, presuming you don't need to display the axes. It won't allow you to manually control the rotation, however. –  David Carraher Dec 25 '13 at 15:19
    
I think this is a dupe... searching... –  Yves Klett Dec 25 '13 at 15:32
1  
Ahhh... possible duplicate of mathematica.stackexchange.com/questions/3759/… –  Yves Klett Dec 25 '13 at 16:40
    
@YvesKlett I think it's not an exact dupe, as OP here ask for being able to manipulate the graphics manually while it's rotating automatically. –  Silvia Dec 25 '13 at 17:03
    
@Silvia you are right. I did not vote to close because of that... Only got my smartphone to browse right now which is ineffective (and too much cake does not help, too) (^_-) –  Yves Klett Dec 25 '13 at 18:50
show 1 more comment

3 Answers

In case this is not a dupe, perhaps this is a starting point.

autoRotate[gr_Graphics3D, rate_: 5] := 
 gr~AbsoluteOptions~#~OptionValue~# &[
   {ViewPoint, ViewVertical}] /. {vp_, vv_} :>
   Show[gr, SphericalRegion -> True, 
    ViewPoint -> Dynamic[RotationMatrix[Clock[2 \[Pi], rate], vv].vp]
    ]

EDIT

Given what I am reading, that manual and automatic interaction are required, perhaps a less hopeless starting point is the following

autoRotate[gr_Graphics3D, rate_: 5] := DynamicModule[{vp, va, vv, vc},
  {vp, va, vv, vc} = gr~AbsoluteOptions~#~OptionValue~# &@
    {ViewPoint, ViewAngle, ViewVertical, ViewCenter};
  Overlay[{
    Show[gr, SphericalRegion -> True,
     ViewPoint -> Dynamic[vp],
     ViewAngle -> Dynamic[va],
     ViewVertical -> Dynamic[vv],
     ViewCenter -> Dynamic[vc]
     ],
    Show[gr, SphericalRegion -> True,
     ViewPoint -> Dynamic[RotationMatrix[Clock[2 \[Pi], rate], vv].vp],
     ViewAngle -> Dynamic[va],
     ViewVertical -> Dynamic[vv],
     ViewCenter -> Dynamic[vc]
     ]
    }, All, 1]
  ]
share|improve this answer
    
This is as great as the last one! May I call you a true Overlay-master! –  Silvia Dec 25 '13 at 18:36
1  
@Silvia That would not be overlay exaggerated. –  Yves Klett Dec 25 '13 at 18:57
    
And I suggest changing the Show[gr, ...] on the first overlay to Show[Graphics3D[], ...], which might give a smoother performance. –  Silvia Dec 25 '13 at 19:03
    
Your autoRotate function works out of the box for a lingering question of mine from a while back. +1 –  bobthechemist Dec 27 '13 at 12:41
    
@bobthechemist I'm glad it helped you too. This can be greatly improved, it is meant as a start. Anyone feel free to build up, edit, or do as you please –  Rojo Dec 27 '13 at 12:43
add comment

I'll join the fun. Here is one with Manipulate. Just a proof of concept ofcourse.

enter image description here

Manipulate[
 tick;
 theta = Mod[theta + step, 360 Degree];
 If[state == "running", tick += del];

 Grid[{
   {Row[{AccountingForm[theta*180/Pi, {5, 2}, 
       NumberPadding -> {"0", "0"}, NumberSigns -> {"", ""}], 
      Degree}]},
   {Graphics3D[
     Rotate[g[[1]], theta, {0, 1, 0}, {0, 0 , 1}],
     SphericalRegion -> True, Axes -> False, Boxed -> False, 
     ViewVertical -> {0, 0, 1}, ViewAngle -> zoom, 
     ViewPoint -> {.5, .5, .7}, 
     PlotRange -> {{-8, 8}, {-3, 3}, {-4, 4 }}, 
     AxesLabel -> {"x", "y", "z"}, ImageSize -> {400}, 
     ImageMargins -> 1, ImagePadding -> 1]
    }
   }],
 Grid[{
   {Grid[{
      {Button[Text[Style["run", 12]], state = "running"; tick += del, 
        ImageSize -> {80, 35}], 
       Button[Text[Style["step", 12]], state = "step"; tick += del, 
        ImageSize -> {80, 35}]}
      }
     ]
    ,
    Grid[{
      {"slow", 
       Manipulator[
        Dynamic[step, {step = #; tick += del} &], {0.001, 1, 0.001}, 
        ImageSize -> Medium, ContinuousAction -> True], "fast", 
       SpanFromLeft},
      {"zoom", 
       Manipulator[
        Dynamic[zoom, {zoom = #; tick += del} &], {0.001, 1, 0.001}, 
        ImageSize -> Medium, ContinuousAction -> True], "out", 
       SpanFromLeft}
      }, Alignment -> Left]}
   }]
 ,
 {{tick, 0}, None},
 {{del, $MachineEpsilon}, None},
 {{step, 0.04}, None},
 {{zoom, 0.01}, None},
 {{state, "reset"}, None},
 {{t, 0}, None},
 {{phi, 0}, None},
 {{theta, 0}, None},
 ContinuousAction -> True,
 Alignment -> Center,
 ImageMargins -> 5,
 FrameMargins -> 5,
 Paneled -> True,
 Frame -> False,
 ControlPlacement -> Top,
 TrackedSymbols :> {tick},
 Initialization :> 
  (
   g = Plot3D[Sin[x y], {x, 0, 3}, {y, 0, 3}]
   )
 ]
share|improve this answer
add comment

Another way by GeometricTransformation:

g = Plot3D[Sin[x y], {x, 0, 3}, {y, 0, 3},
           PlotRange -> {{-1, 4}, {-1, 4}, Automatic},
           SphericalRegion -> True]

center = Mean /@ (PlotRange /. AbsoluteOptions[g, PlotRange])

DynamicModule[{θ},
              DynamicWrapper[
                             MapAt[
                                   GeometricTransformation[#,
                                     RotationTransform[Dynamic[θ], {0, 0, 1}, center ]
                                     ] &,
                                   g, 1],
                             θ = Clock[{0, 2 π, .01}, 10]
                            ]]
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.