2
$\begingroup$

I am new to Mathematica and I am trying to create a small animation using SphericalPlot3D. Essentially I have a 3D figure defined in SphericalPlot3D[Combination of SphericalHarmonics(l,m)]. The output is exactly as I want it and all is well for now.

I am trying to make the 3D figure rotate on itself using Euler Angles technique for parametrisation of motion with respect to an internal reference frame. I know that GeometricTransformation[...,Euler Rotate] works on Graphics3D but it appears that the GeometricTransformation does not work with SphericalPlot3D. I have tried to define my figure in Graphics3D without success... If anyone could help, that would be very much appreciated

Here is the code for my figure:

Manipulate[SphericalPlot3D[1 + b*Cos[g]*1/4 Sqrt[5/π] (-1 + 3 Cos[t]^2) + 
   (b/Sqrt[2])*Sin[g] (1/4 E^(-2 I p) Sqrt[15/(2 π)] Sin[t]^2 + 
    1/4 E^(2 I p) Sqrt[15/(2 π)] Sin[t]^2), 
   {t, 0, Pi},  {p, 0, 2*Pi}, AxesLabel -> {x, y, z}], 
 {b, 0, 0.4}, {g, 0, Pi/3}]
$\endgroup$
3
  • 1
    $\begingroup$ does this help: sp1 = With[{b = 0.5, g = 2}, SphericalPlot3D[ 1 + 1/4 b Cos[g] Sqrt[ 5/π] (-1 + 3 Cos[t]^2) + (b Sin[ g] (1/4 E^(-2 I p) Sqrt[15/(2 π)] Sin[t]^2 + 1/4 E^(2 I p) Sqrt[15/(2 π)] Sin[t]^2))/Sqrt[2], {t, 0, π}, {p, 0, 2 π}]]; em = EulerMatrix[{π/3, π/2, π/4}]; Show[MapAt[GeometricTransformation[#, em] &, sp1, {1}], PlotRange -> All]? $\endgroup$
    – kglr
    Jun 19, 2018 at 10:09
  • $\begingroup$ Yes! That's in the direction i wish to go in. I intend to make an animation of the figure so that it rotate on its own. i'll add varying parameters to the EulerMatrix now and see how it goes. Thanks ! $\endgroup$ Jun 19, 2018 at 10:20
  • $\begingroup$ Laudicina, welcome to mma.se. I posted the comment as an answer. $\endgroup$
    – kglr
    Jun 19, 2018 at 10:38

1 Answer 1

3
$\begingroup$

You can MapAt your GeometricTransformation at level {1} of the SphericalPlot3D:

Manipulate[Show[MapAt[GeometricTransformation[#, EulerMatrix[{angle1, angle2, angle3}]] &,
  SphericalPlot3D[1 +  b*Cos[g]*1/4 Sqrt[5/π] (-1 + 3 Cos[t]^2) + 
   (b/Sqrt[2])* Sin[g] (1/4 E^(-2 I p) Sqrt[15/(2 π)] Sin[t]^2 + 
    1/4 E^(2 I p) Sqrt[15/(2 π)] Sin[t]^2), 
   {t, 0, Pi}, {p, 0, 2*Pi}, AxesLabel -> {x, y, z}], {1}], PlotRange -> All],
 {b,  0, 0.4}, {g, 0, Pi/2}, 
 {{angle1, Pi/3}, Range[0, 2 Pi, Pi/8], SetterBar },
 {{angle2, Pi/2}, Range[0, 2 Pi, Pi/8],  SetterBar} ,
 {{angle3, Pi/4}, Range[0, 2 Pi, Pi/8], SetterBar } ]

enter image description here

$\endgroup$
1
  • $\begingroup$ Thanks very much kglr! I had managed to figure the manipulate part by myself but cheers for the swift reply $\endgroup$ Jun 19, 2018 at 11:26

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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