Animated 3d graphic with some additional math requirements

Question

I posted to this post before, but I still could not completely solve the following problem. As an example:

{pA, pB, pC, pD} = {{0, 0, Sqrt[61/3]}, {Sqrt[7], 4*Sqrt[2/3], 0}, {0, -5*Sqrt[2/3], 0}, {-Sqrt[71], 4*Sqrt[2/3], 0}};
axis={1,0,0};pt={0,1,0};
plotPolygon[{a_, b_, c_}] := {Opacity[.4], Polygon[{a, b, c}]};
graph=Graphics3D[{plotPolygon[{pA, pB, pC}], plotPolygon[{pA, pB, pD}], 
            plotPolygon[{pB, pC, pD}], plotPolygon[{pA, pC, pD}]}, 
            Axes -> True, AxesOrigin->pt];
Animate[graph/.gg : Graphics3D[___] :> Rotate[gg, theta, axis], {theta, 0., 2.*Pi}]

I want to rotate the axis axis={1,0,0}that passes the point pt={0,1,0}. But I do not know how to indicate the point information. Also, the rotation animation seems very chaotic in the sense that I would expect at least one point (in this case, the beginning?) Does not rotate.

Answer 1

You need to first change the beginning of the vertices of your polygon, rotate and translate back. You can do it manually

(RotationMatrix[theta,axis].(#-pt) + pt)& /@ {pA, pB, pC, pD}

Or you can combine transforms using Composition

Composition[
 AffineTransform[{RotationMatrix[theta,axis],pt}],TranslationTransform[-pt]
] /@ {pA, pB, pC, pD}

Graphics

GeometricTransformation[ <graphics>, Composition[ ... ]]

, .

: script

Animate[
  graph /. Graphics3D[prims__, opts : OptionsPattern[]] :> 
    Graphics3D[
      GeometricTransformation[prims,
        Composition[
          AffineTransform[{RotationMatrix[theta, axis], pt}],
          TranslationTransform[-pt]
        ]
      ],
      opts
    ], 
  {theta, 0., 2.*Pi}
]

. -, GeometricTransformation , Graphics3D Graphics3D[prims__, opts : OptionsPattern[]]. , Animate, theta.