0

I have a 3D arc which is moving over the surface of a sphere. I want to do the animation of it. The following code is my try:

arc[σ_, ν_, τ_] := {Cos[ϕ]*Cos[θ], 
    Sin[ϕ]*Cos[θ], 
    Sin[θ]} /. {ϕ -> τ + 
      ArcTan[ν Sqrt[1 - ν^2]
         Tanh[(σ + ν τ)/Sqrt[
         1 - ν^2]]], θ -> 
     ArcSin[Sqrt[1 - ν^2]/
      Cosh[(σ + ν τ)/Sqrt[1 - ν^2]]]};
Animate[Show[
  ParametricPlot3D[{Cos[ϕ]*Sin[θ], 
    Sin[ϕ]*Sin[θ], Cos[θ]}, {ϕ, 0, 
    2 π}, {θ, -π, π}, 
   PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}, PlotStyle -> Gray], 
  Graphics3D[{Red, Thickness[0.01], 
    Line[Table[
      arc[σ, .7, τ], {σ, -π, π, π/
        64}]]}, {{-1, 1}, {-1, 1}, {-1, 1}}], Boxed -> False, 
  Axes -> False], {τ, 0, 4}]  

But the problem is during the animation smooth texture of the sphere lost and when I stop animation it regains the smooth texture. Is it possible to get the smooth texture of the sphere during the animation?

Kuba
  • 136,707
  • 13
  • 279
  • 740
m. bubu
  • 565
  • 2
  • 13

0 Answers0