3
$\begingroup$

I am trying to draw an arrow that originates from point {0,0,0} to the point of the curve. The arrow should rotate around the curve. I am attaching an animated figure as well so you know where the head of the arrow should be.

The last command is the one that I would like to get your comment to fix.

ClearAll["Global`*"] (*Remove all global variables*)
alpha1 = 0.1;
gamma = 1/(1 + alpha1^2);
hexternal = {1, 0, 0};

hxexternal = hexternal[[1]];
hyexternal = hexternal[[2]];
hzexternal = hexternal[[3]];

equationM1 = {M1'[t] == 
    gamma*(alpha1*((Cos[M1[t]]*Cos[M2[t]])*
           hxexternal + (Cos[M1[t]]*Sin[M2[t]])*hyexternal - 
          Sin[M1[t]]*hzexternal) + ((-Sin[M2[t]])*
          hxexternal + (Cos[M2[t]])*hyexternal))};
equationM2 = {M2'[t] == 
    gamma*((-1/
          Sin[M1[t]])*((Cos[M1[t]]*Cos[M2[t]])*
           hxexternal + (Cos[M1[t]]*Sin[M2[t]])*hyexternal - 
          Sin[M1[t]]*hzexternal) + (alpha1/
          Sin[M1[t]])*((-Sin[M2[t]])*hxexternal + (Cos[M2[t]])*
           hyexternal))};

initial1 = {M1[0] == Pi/2 + 0.01};
initial2 = {M2[0] == Pi + 0.01};

eqns = Join[equationM1, equationM2, initial1, initial2];

sol1 = NDSolve[eqns, {M1[t], M2[t]}, {t, 0, 100}, 
   StartingStepSize -> 1/100, 
   Method -> {"FixedStep", Method -> "ExplicitEuler"}];
{M1[t], M2[t]} = {M1[t], M2[t]} /. sol1[[1]];

x = Sin[M1[t]]*Cos[M2[t]];
Plot[x, {t, 0, 100}, PlotRange -> All, PlotStyle -> {Blue, Red}, 
 PlotLegends -> "Expressions"]
y = Sin[M1[t]]*Sin[M2[t]];
Plot[y, {t, 0, 100}, PlotRange -> All, PlotStyle -> {Blue, Red}, 
 PlotLegends -> "Expressions"]

z = Cos[M1[t]];
Plot[z, {t, 0, 100}, PlotRange -> All, PlotStyle -> {Blue, Red}, 
 PlotLegends -> "Expressions"]


ParametricPlot3D[{x, y, z}, {t, 0, 100}, PlotRange -> 1, 
 BoxRatios -> {1, 1, 1}, AxesLabel -> {X, Y, Z}]


imgtable = 
   Table[ParametricPlot3D[Evaluate[{x, y, z}], {t, 0, tmax}, 
     PlotRange -> 1, BoxRatios -> {1, 1, 1}, 
     AxesLabel -> {X, Y, Z}], {tmax, 0.3, 100, 5}];~Monitor~tmax
ListAnimate[imgtable]


ListAnimate@
  Table[Graphics3D[{Red, Arrowheads[0.1], 
     Arrow[Tube[{{0, 0, 0}, {x[t] \.t -> tmax, y[t] \.t -> tmax, 
         z[t] \.t -> tmax}}]]}, PlotRange -> 1, 
    BoxRatios -> {1, 1, 1}, AxesLabel -> {X, Y, Z}], {tmax, 0.3, 100, 
    5}]~Monitor~tmax (*The command needs to be changed*)

enter image description here

$\endgroup$
1
  • $\begingroup$ 1. \. is apparently wrong. 2. You're mixing up function and function relationship, think about what's wrong with the following: f=Sin[t]; f[1]. $\endgroup$ – xzczd Mar 24 '20 at 2:47
4
$\begingroup$

As noted by @xzczd, the $t$ is already hardwired into your definition of $x$, so you can't use the expression x[t]. The correct expression is just x, as in your Plot[x, ...] commands. I think this is where you are trying to go, more or less

ListAnimate[Table[
  p = ParametricPlot3D[Evaluate[{x, y, z}], {t, 0, tmax}];
  g = Graphics3D[{Red, Arrowheads[0.1],
     Arrow[Tube[{{0, 0, 0}, {x, y, z} /. t -> tmax}]]}];
  Show[p, g, PlotRange -> {1, 1, 1},
   BoxRatios -> {1, 1, 1}, AxesLabel -> {X, Y, Z},
   PlotLabel -> Style[Row[{"tmax =", tmax}], Blue]],
  {tmax, 0.3, 100, 5}]
 ]

enter image description here

I don't know how use the Monitor command with ListAnimate, so I just added a plot label.

$\endgroup$
9
$\begingroup$

Another elegant solution is to simply take your full parameteric plot:

g = ParametricPlot3D[Evaluate[{x, y, z}], {t, 0, 100}, 
     PlotRange -> 1, BoxRatios -> {1, 1, 1}, 
     AxesLabel -> {X, Y, Z}];

Extract the points and then use this sweet ResourceFunction from Jon Mcloone:

pts = Cases[g[[1]], Line[pts_, rest___] :> pts, \[Infinity]][[1]];
b = BSplineCurve[Flatten[Partition[pts,2,1],1]];
Graphics3D[ResourceFunction["AnimatedArrow"][b, 
   "HeadCount" -> 20, "Period" -> 60, "HeadSize" -> .02]]

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.