3
$\begingroup$

Previous

Code

curve = KnotData[{"TorusKnot", {2, 5}}, "SpaceCurve"];

knot = {knot1, knot2} =
     {curve[u], RotationMatrix[{{1, 0, 0}, {0, 0, 1}}].curve[u] + {0, 0, 4}};

Show[ParametricPlot3D[{knot1, knot2}, {u, 0, 2 Pi}, ViewPoint -> Left], 
    Graphics3D[{Sphere[knot /. u -> 1.22 Pi, 0.1], Thick, Dashed, Pink, 
        Line[knot /. u -> 1.22 Pi]}], Boxed -> False, Axes -> False]

Export["01.png", %, Background -> None] // AbsoluteTiming

two knots

Table[
    ParametricPlot3D[curve[u], {u, 0, 2 Pi},
    Boxed -> False, Axes -> False, SphericalRegion -> True,
    ViewVector -> RotationMatrix[t, {0, 0, 1}].{10, 0, 5}],
    {t, 0, 2 Pi, Pi/40}];

Export["02.gif", %,
    "TransparentColor" -> White,
    "TransitionEffect" -> "Background", 
    "AnimationRepetitions" -> ∞] // AbsoluteTiming

ListAnimate[%%]

knot animation


Purpose

I want the 2 graph elements (knot1 and knot2) rotate at the same time, while the left 2 points and their connection lines do not move keep on the specified side of the view.




Solution

Code

curve = KnotData[{"TorusKnot", {n = 2, 5}}, "SpaceCurve"];


knotBase = curve[u];
offSet = {0, 0, 4.5};
viewVector = {50, 0, 30};
slant = RotationMatrix[{{0, 0, 1}, viewVector}].knotBase;
rotateAroundZ = RotationMatrix[t, {0, 0, 1}];

Default@plot = IdentityMatrix@3;
plot[kI_., vI_.] :=
    Block[{knotCopy = kI.slant + offSet,
           knots = {knotBase, knotCopy},
           viewVector = vI.viewVector}
        ,
        Table[Show[
            ParametricPlot3D[Evaluate@knots, {u, 0, 2 Pi}], 
            dotLine = knots /. u -> t/2;
            Graphics3D[{Sphere[dotLine, 0.1],
                        Thick, Dashed, Pink, Line[dotLine]}]
            ,
            PlotRange -> {{-3, 3}, {-3, 3}, {-1, 7.5}}, 
            Boxed -> False, Axes -> False,
            SphericalRegion -> True, 
            ViewVector -> viewVector]
            ,
            {t, 0, 2 n Pi, Pi/90}]]

p1 = plot[];
p2 = plot[rotateAroundZ.RotationMatrix[t, -viewVector],
         rotateAroundZ];

ListAnimate /@ {p1, p2}


pGIF[{p_, name_}] :=
    Export[name <> ".gif", p,
        "TransparentColor" -> White,
        "TransitionEffect" -> "Background", 
        "AnimationRepetitions" -> ∞] // AbsoluteTiming

pGIF@# & /@ {{p1, "p1"}, {p2, "p2"}}

p1 (stir-like) :
stir-like

p2 (gear-like) :
gear-like


Thanks for @HenrikSchumacher's help!

$\endgroup$
0

1 Answer 1

5
$\begingroup$

You have first to rotate the knot, then translate. Instead, you rotate the whole plot. Try this:

expr =
  {
   {0, 0, 4} + 
    RotationMatrix[
      t, {1, 0, 0}].RotationMatrix[{{1, 0, 0}, {0, 0, 1}}].curve[u],
   {0, 0, 4} + {0, 4 Cos[u], 4 Sin[u]}
   };
g = Table[
   ParametricPlot3D[expr, {u, 0, 2 Pi}, ViewPoint -> Right, 
    Boxed -> False, Axes -> False,
    SphericalRegion -> True], {t, 0, -2 Pi, -Pi/20}];
ListAnimate@g
$\endgroup$
2
  • $\begingroup$ (a.gif) is OK, but without the outer circle, it shaking again (b.gif) 😂?! $\endgroup$
    – ooo
    Mar 6, 2018 at 13:35
  • 2
    $\begingroup$ That's because the bounding box varies: The knot has changing radius under rotation. Just prescribe a fixed PlotRange for all frames. $\endgroup$ Mar 6, 2018 at 14:07

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.