Mathematica Animate & animated gif in Mathematica

[ilvreth]

"Animate" & animated gif in Mathematica

Hi to all. This period i am working on a project. I want to demonstrate the motion of a vector in 3D animation.

I have a txt file with 4 columns and 8010 lines data. The first column is the time and the three other are the components of the vector in 3D space. Then i wrote down a mathematica nb which does the following job: First i read the first line data from the file (time, Sx, Sy, Sz) and
creates an arrow in 3D. Then the result is updated by a do loop where it reads the next line ect.

I want this "animate" to be exported in a animated gif file. I tried but something goes wrong.

Could you please help me with this?

Here is the code and the txt file with a few data.

SetDirectory[NotebookDirectory[]];
mat = Import["Vector.txt", "Table"];
Do[S[i, j] = mat[[i, j]], {i, 2010}, {j, 4}]
(* 2010 are the lines in Vector.txt *)
list = Animate[
  P = {S[i, 2], S[i, 3], S[i, 4]}; 

(* S[i,1]=time, S[i,2]=Sx, S[i,3]=Sy, S[i,4]=Sz*)
  
  w = Graphics3D[{Red, Arrowheads[0.1], 
     Arrow[Tube[{{0, 0, 0}, P}, 0.09]]}];

  sp = Graphics3D[{{Opacity[0.7], GrayLevel[.25], 
      Specularity[White, 10], Sphere[{0, 0, 0}, 2.5]}}];

  s = Graphics3D[{Line[ps {{-2.5, 0, 0}, {2.5, 0, 0}}], 
      Line[ps {{0, -2.5, 0}, {0, 2.5, 0}}], 
      Line[ps {{0, 0, -2.5}, {0, 0, 2.5}}], 
      Text["\!\(\*SubscriptBox[\(S\), \(x\)]\)", {lp, 0, 0}], 
      Text["\!\(\*SubscriptBox[\(S\), \(y\)]\)", {0, lp, 0}], 
      Text["\!\(\*SubscriptBox[\(S\), \(z\)]\)", {0, 0, 
        lp}]} /. {ps -> 2.5, lp -> 2.7}];
  Show[{w, s, sp}, Axes -> True, AspectRatio -> 1, 
   AxesLabel -> {Style["[100]", Bold], Style["[010]", Bold], 
     Style["[001]", Bold]}, 
   PlotRange -> {{-2.5, 2.5}, {-2.5, 2.5}, {-2.5, 2.5}}, 
   PlotLabel -> Style[S[i, 1], Bold, RGBColor[.25, .43, .82]], 
   ImageSize -> {500, 500}], {i, 1, 2010, 1}, DefaultDuration -> 10, 
  AnimationRunning -> False]
Export["anim.gif",list,"DisplayDurations"->0.01]

 

[djelovin]

Try this:

SetDirectory[NotebookDirectory[]];
mat = Import["Vector.txt", "Table"];

sp = {Opacity[0.7], GrayLevel[.25], Specularity[White, 10], 
   Sphere[{0, 0, 0}, 2.5]};

s = {Line[ps {{-2.5, 0, 0}, {2.5, 0, 0}}], 
    Line[ps {{0, -2.5, 0}, {0, 2.5, 0}}], 
    Line[ps {{0, 0, -2.5}, {0, 0, 2.5}}], 
    Text["\!\(\*SubscriptBox[\(S\), \(x\)]\)", {lp, 0, 0}], 
    Text["\!\(\*SubscriptBox[\(S\), \(y\)]\)", {0, lp, 0}], 
    Text["\!\(\*SubscriptBox[\(S\), \(z\)]\)", {0, 0, lp}]} /. {ps -> 
     2.5, lp -> 2.7};

Animate[Graphics3D[{{Red, Arrowheads[0.1], 
    Arrow[Tube[{{0, 0, 0}, mat[[u, 2 ;; 4]]}, 0.09]]}, s, sp}, 
  PlotRange -> {{-2.5, 2.5}, {-2.5, 2.5}, {-2.5, 2.5}}], {u, 1, 
  Length[mat], 1}]

You don't need every frame! (because .gif file is then 50MB large)

Export["vector.gif", 
 Table[Graphics3D[{{Red, Arrowheads[0.1], 
     Arrow[Tube[{{0, 0, 0}, mat[[u, 2 ;; 4]]}, 0.09]]}, s, sp}, 
   PlotRange -> {{-2.5, 2.5}, {-2.5, 2.5}, {-2.5, 2.5}}], {u, 1, 
   Length[mat], 5}], "DisplayDurations" -> 0.01]

 

[ilvreth]

Thank you very much! Seems you are expert in mathematica.

Thank you again!