# Trouble Mapping a Geometric Transformations over a List of different types of Graphics Objects

I am working on some code that allows me to auto-rotate graphics (including ParmetricPlot3D and Plot3D graphics) objects while preserving mouse dragging in a smooth fashion. It works great.

The code below includes three different types of graphics objects (Graphics3D, ParametricPlot3D, and Plot3D), but I have more types to implement. I should be able to Map the single geometric transformation over the list but can't figure it out. Independently it works fine and the code is repetitive. Seems like I should be able to condense but I'm not able.

You can see the repetition three times in the code below.

Manipulate[Show[

Map[(GeometricTransformation[#,
RotationTransform[Dynamic[\[Theta]], {0, 0, 1}, center]] &),
Graphics3D[{Arrow[Tube[{{-3.75, 0, 0}, {3.75, 0, 0}}, .01]],
Arrow[Tube[{{0, -3.75, 0}, {0, 3.75, 0}}, .01]],
Arrow[Tube[{{0, 0, -3.75}, {0, 0, 3.75}}, .01]]}]],

Map[GeometricTransformation[#,
RotationTransform[Dynamic[\[Theta]], {0, 0, 1}, center]] &,
ParametricPlot3D[{u, v, v^2}, {u, -4, 4}, {v, -4, 4}]],

Map[GeometricTransformation[#,
RotationTransform[Dynamic[\[Theta]], {0, 0, 1}, center]] &,
Plot3D[x^2 + y^2, {x, -4, 4}, {y, -4, 4}]],

PlotRange -> 4, SphericalRegion -> True], {\[Theta], 0, 2 Pi,
ControlType -> Animator, AnimationRate -> .03},
Initialization :> {center =
Mean /@ (PlotRange /.
AbsoluteOptions[
Graphics3D[{Arrow[Tube[{{-3.75, 0, 0}, {3.75, 0, 0}}, .01]],
Arrow[Tube[{{0, -3.75, 0}, {0, 3.75, 0}}, .01]],
Arrow[Tube[{{0, 0, -3.75}, {0, 0, 3.75}}, .01]]}],
PlotRange])}]


As you can see I have mapped the GeometricTransformation over Graphics3D and ParametricPlot3D and Plot3D independently which I believe is overkill. I have more types to plot as well. I would like to call the Map function only once for all graphics objects.

I tried using Map to push through the list of graphics objects it doesn't seem to work. I've also tried, MapThread, MapApply, Apply, etc.

It's probably a very simple solution, but it escapes me. Any ideas?

gr = {Graphics3D[{Arrow[Tube[{{-3.75, 0, 0}, {3.75, 0, 0}}, .01]],
Arrow[Tube[{{0, -3.75, 0}, {0, 3.75, 0}}, .01]],
Arrow[Tube[{{0, 0, -3.75}, {0, 0, 3.75}}, .01]]}],
Graphics3D[{Cube[{1, 0, 0}, 1]}],
Plot3D[x^2 + y^2, {x, -4, 4}, {y, -4, 4}],
ParametricPlot3D[{u, v, v^2}, {u, -4, 4}, {v, -4, 4}]};

Manipulate[
Show[(g |->
Map[(GeometricTransformation[#,
RotationTransform[Dynamic[\[Theta]], {0, 0, 1}, center]] &),
g]) /@ gr, PlotRange -> 4, SphericalRegion -> True], {\[Theta],
0, 2 Pi, ControlType -> Animator, AnimationRate -> .03},
Initialization :> {center =
Mean /@ (PlotRange /.
AbsoluteOptions[
Graphics3D[{Arrow[Tube[{{-3.75, 0, 0}, {3.75, 0, 0}}, .01]],
Arrow[Tube[{{0, -3.75, 0}, {0, 3.75, 0}}, .01]],
Arrow[Tube[{{0, 0, -3.75}, {0, 0, 3.75}}, .01]]}],
PlotRange]);}]

• Thank you. I'm sorry I should have been more clear. My issue is that I have a number of different graphics objects, like Plot3D, and ParametricPlot3D (not all Graphics3D) I can't figure out how to combine them into your gr variable. I'll update the question to pinpoint my issue. Nov 30, 2022 at 23:09
• I updated my answer. Nov 30, 2022 at 23:23
• hmmmm. I am missing something. : ( Where can include a Plot3D, ParmetricPlot3D, RevolutionPlot3D, etc? I see how you are combining Graphics3D objects. But not sure how to incorporate the 3D graphics functions mentioned. Show[] doesn't work. I've only been able to map the transformations of these functions on an individual basis, yet the code is the same for all of them. Seems like I should be able to condense the code. You can see the repetition in my updated post. Nov 30, 2022 at 23:33
• Did you test my last update? Nov 30, 2022 at 23:35
• I did not know you can do that. Enlightening! TY Nov 30, 2022 at 23:39