0
$\begingroup$

I am trying to animate the movement of an Arrow on a sphere. I have this code that allows me to manipulate the arrow, but I want it to move based on a set of data. I have no idea how to 'listplot' inside a Graphics3D?:

Manipulate[
  Graphics3D[{{Opacity[0.5], Sphere[]}, {EdgeForm[{Dashed, Gray}], 
    FaceForm[None], Cylinder[{{0, 0, -.001}, {0, 0, .001}}]}, {Dashed,
    Gray, Line[{{0, 0, 0}, {1, 0, 0}}]}, {Dashed, Gray, 
    Line[{{0, 0, 0}, {0, 1, 0}}]}, {Dashed, 
    Line[{{0, 0, 0}, {0, 0, 1}}]}, Arrow[{{1, 0, 0}, {1.3, 0, 0}}], 
    Arrow[{{0, 1, 0}, {0, 1.3, 0}}], 
    Arrow[{{0, 0, 1}, {0, 0, 1.3}}], {Purple, 
    Arrow[{{0, 0, 0}, {π/4, 0, π/4}}]}, 
    Text[Style["x", 18], {1.4, 0, 0}], 
    Text[Style["y", 18], {0, 1.4, 0}], 
    Text[Style["Easy Axis [\!\(\*OverscriptBox[\(z\), \(^\)]\)]", 
     18], {0, 0, 1.4}], 
    Text[Style["H", 18, Purple], {π/3.4, 0, π/3.4}], 
    Text[Style["M", 14, 
    Darker[Green]], .5 {Cos[θ] Sin[ϕ], 
    Sin[θ] Sin[ϕ], Cos[ϕ]}], {Darker[Green], 
    Arrow[{{0, 0, 0}, {Cos[θ] Sin[ϕ], 
    Sin[θ] Sin[ϕ], Cos[ϕ]}}]}}, 
  Boxed -> False], {θ, 0, 2 π}, {{ϕ, .3}, 0, π}
]

Example data would be four columns, count, xcoord, ycoord, zcoord with the arrow always originating at {0,0,0}. Eg.:

29,000  -0.01067794941476   0.02756065400125    -0.999563100433
30,000  0.07325953072891    0.02559283462283    -0.9969844772981
31,000  -0.005206656374045  0.003809329014993   -0.9999791896544
32,000  0.02758052262388    -0.05023222467678   -0.9983566689194
33,000  -0.1557215814703    -0.3822367499471    -0.9108489754368
34,000  -0.02183443939687   -0.00812340680513   -0.9997285969292
35,000  0.01756289415653    -0.2391312516637    -0.9708284035949
36,000  0.013100869468      0.05208820150161    -0.9985565514699
37,000  -0.0008172482767943 0.005544158052967   -0.9999842970851
38,000  0.02308873858545    0.020848131024      -0.9995160156713
39,000  0.06752309311563    0.09324836930484    -0.9933505793616
40,000  0.02615295865362    0.03324502256054    -0.9991049950974
41,000  -0.0008738204745279 -0.0004833505961394 0.9999995014049
42,000  0.004601097882045   -0.004323429447502  0.9999800687294
43,000  -0.009100312671195  -0.002732110663704  0.9999548589214
44,000  -0.05848480012902   -0.00294792905828   0.9982839465143
45,000  0.006215303347235   0.01116769657516    0.9999183229432
46,000  0.01840111926142    0.006187994275549   0.999811536009
47,000  -0.008149533077329  0.00850954038223    0.9999305840073
48,000  -0.008600208894006  0.01017799852903    0.9999112184354
49,000  8.736914618394e-05  -0.003424202086108  0.9999941335861
$\endgroup$
3
$\begingroup$
  1. Import your tip position data, removing the "count" column, which seems irrelevant:

table = {{29000, -0.01067794941476, 0.02756065400125, -0.999563100433}, {30000, 0.07325953072891, 0.02559283462283, -0.9969844772981}, {31000, -0.005206656374045, 0.003809329014993, -0.9999791896544}, {32000, 0.02758052262388, -0.05023222467678, -0.9983566689194}, {33000, -0.1557215814703, -0.3822367499471, -0.9108489754368}, {34000, -0.02183443939687, -0.00812340680513, -0.9997285969292}, {35000, 0.01756289415653, -0.2391312516637, -0.9708284035949}, {36000, 0.013100869468, 0.05208820150161, -0.9985565514699}, {37000, -0.0008172482767943, 0.005544158052967, -0.9999842970851}, {38000, 0.02308873858545, 0.020848131024, -0.9995160156713}, {39000, 0.06752309311563, 0.09324836930484, -0.9933505793616}, {40000, 0.02615295865362, 0.03324502256054, -0.9991049950974}, {41000, -0.0008738204745279, -0.0004833505961394, 0.9999995014049}, {42000, 0.004601097882045, -0.004323429447502, 0.9999800687294}, {43000, -0.009100312671195, -0.002732110663704, 0.9999548589214}, {44000, -0.05848480012902, -0.00294792905828, 0.9982839465143}, {45000, 0.006215303347235, 0.01116769657516, 0.9999183229432}, {46000, 0.01840111926142, 0.006187994275549, 0.999811536009}, {47000, -0.008149533077329, 0.00850954038223, 0.9999305840073}, {48000, -0.008600208894006, 0.01017799852903, 0.9999112184354}, {49000, 0.00008736914618394, -0.003424202086108, 0.9999941335861}}[[All, 2 ;;]];

  1. Modify the specification of your moving arrow to use Arrow[{{0, 0, 0}, tip}], then construct a table of graphics objects in which tip takes all values from table above.

  2. Use ListAnimate on the list of Graphics3D objects to generate an animation.

The result is:

ListAnimate@Table[
  Graphics3D[{
    {Opacity[0.5], Sphere[]},
    {EdgeForm[{Dashed, Gray}], FaceForm[None], 
     Cylinder[{{0, 0, -.001}, {0, 0, .001}}]},
    {Dashed, Gray, Line[{{0, 0, 0}, {1, 0, 0}}]},
    {Dashed, Gray, Line[{{0, 0, 0}, {0, 1, 0}}]},
    {Dashed, Line[{{0, 0, 0}, {0, 0, 1}}]},
    Arrow[{{1, 0, 0}, {1.3, 0, 0}}],
    Arrow[{{0, 1, 0}, {0, 1.3, 0}}],
    Arrow[{{0, 0, 1}, {0, 0, 1.3}}],
    {Purple, Arrow[{{0, 0, 0}, {Pi/4, 0, Pi/4}}]},
    Text[Style["x", 18], {1.4, 0, 0}],
    Text[Style["y", 18], {0, 1.4, 0}],
    Text[Style["Easy Axis [\!\(\*OverscriptBox[\(z\), \(^\)]\)]", 18], {0, 0, 1.4}],
    Text[Style["H", 18, Purple], {Pi/3.4, 0, Pi/3.4}],

    (* Here are the changes to your original graphics code: *)
    Text[Style["M", 14, Darker[Green]], .5 tip],
    {Darker[Green], Arrow[{{0, 0, 0}, tip}]}

   },
   Boxed -> False
  ],
  {tip, table}
]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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