1
$\begingroup$

I want to get trace animation, which forms 3D object at last. Though I saw ring shape structural animation in the website: https://community.wolfram.com/groups/-/m/t/1991109 also Creating a movie of an animated trajectory

Unfortunately,I couldn't make similar image for sphere and atomic (Pi) orbital.

The purpose of this 3D animation is to explain electron orbital formation image, using the animation of electron trajectory.

I also found another example for animation of trajectory

curve[t_] := 
With[{c = ArcTan[a t]}, r {Cos[t] Cos[c], Sin[t] Cos[c], -Sin[c]}]
Block[{r = 1, a = .2}, 
sphere = Show[
ParametricPlot3D[curve[t], {t, -30, 30}, PlotRange -> All]];
imglist = 
Table[Show[{sphere, 
Graphics3D@{Red, PointSize[Large], 
Sphere[curve[tt], .1]}}], {tt, -30, 30, .1}];]

ListAnimate[imglist]

But this has already has trajectory line before the red ball runs, and we don't get clear sphere image at last...(a little sparse)

I tried to get sphere animation by myself like

Animate[ParametricPlot3D[{Cos[th]*Cos[ph], Cos[th]*Sin[ph], 
Sin[th]}, {th, 0, a}, {ph, 0, a}, 
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}], {a, 0, 2 Pi}]
an = Table[
ParametricPlot3D[{Cos[th]*Cos[ph], Cos[th]*Sin[ph], Sin[th]}, {th, 
0, a}, {ph, 0, a}, PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}], {a,
0, 2 Pi}]
 

However, I failed to use the command Epilog, and no ball to move, nor any trajectory line... just closed surface...

If someone knows how to get ball trajectory animation, which at last get spherical like image? It is also OK if the ball runs along the half-transparent spheres.

In addition, if possible, I wonder if you also tell me how to make the similar animation of atomic Pi orbital.

px[\[Theta]_, \[CurlyPhi]_] = 
SphericalHarmonicY[1, -1, \[Theta], \[CurlyPhi]] - 
SphericalHarmonicY[1, 1, \[Theta], \[CurlyPhi]] // FullSimplify;

SphericalPlot3D[
Abs[px[\[Theta], \[CurlyPhi]]]^2, {\[Theta], 0, \[Pi]}, {\[CurlyPhi],
0, 2 \[Pi]}, PlotRange -> All]
$\endgroup$

1 Answer 1

2
$\begingroup$

The local constants in Block were missing

   curve[t_]:=With[{c=ArcTan[a t]},r {Cos[t] Cos[c],Sin[t] Cos[c],-Sin[c]}]

    Block[{r=1,a=.2},sphere=Show[ParametricPlot3D[curve[t],
                                    {t,-30,30},PlotRange->All]]]

curve

      Block[{r=1,a=.2},
          Graphics3D[{Red,PointSize[Large],Sphere[curve[0.8],.1]}]]

    imglist=Block[{r=1,a=.2},
      Table[Show[{sphere,Graphics3D@{Red,PointSize[Large],
             Sphere[curve[tt],.1]}}],{tt,-30,30,.1}]];

      imagelist[[300]]

point on curve

ListAnimate[imglist]

$\endgroup$
4
  • $\begingroup$ Thank you for your suggestion. $\endgroup$
    – rani
    Commented Jun 22, 2023 at 0:44
  • $\begingroup$ I don't know why but the red ball is too big and animation doesn't move... And sorry for my bad explanation, I want to change the trajectory above. This trajectory is condense at the poles and sparse in the middle. The desired trajectory is like walking around; (Hydrogen atom) youtube.com/watch?v=0kRvVR8Y9lw I think I should change the Function "Curve[t_]" should be changed, but I don't have idea how to do it. $\endgroup$
    – rani
    Commented Jun 22, 2023 at 0:50
  • $\begingroup$ Another example of walking around (Pi orbital) is like this youtube.com/watch?v=LQrSpIhLf9A $\endgroup$
    – rani
    Commented Jun 22, 2023 at 0:52
  • $\begingroup$ The distribution of the spiral over the sphere depends on the parametization $t\to \theta[t]$ per round of $\phi$. Simply replace the $\arctan$ by a Manipulate`d constant. Discard the useless PointSize and reduve the radius of Sphere[]. $\endgroup$
    – Roland F
    Commented Jun 22, 2023 at 7:13

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.