# How to make a 3D plot auto-rotate?

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

• 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. – DavidC Dec 25 '13 at 15:19
• I think this is a dupe... searching... – Yves Klett Dec 25 '13 at 15:32
• 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

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

• This is as great as the last one! May I call you a true Overlay-master! – Silvia Dec 25 '13 at 18:36
• @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

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


I'll join the fun. Here is one with Manipulate. Just a proof of concept ofcourse. 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[], 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}]
)
]