Wolfram mathematica 根据mathematica中的一些进一步要求制作3d绘图动画

我以前在上贴过，但我仍然无法完全解决以下问题。例如：

{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}]

---

我想沿着一个轴旋转，该轴通过点

pt={0,1,0}

。但我不知道如何指定点信息。此外，旋转动画看起来非常混乱，因为我预计至少有一个点（在本例中，原点？）没有旋转。

您需要首先更改多边形顶点的原点，旋转并向后平移。你可以手工做这个

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

或者，您可以使用

或者，您可以将上一个构图直接应用于

图形

对象

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

---

这里有几件事需要注意。首先，

GeometricTransformation

似乎只对原语本身起作用，因此我必须通过规则

Graphics3D[prims，opts:OptionsPattern[]

将原语从

Graphics3D

中的选项中分离出来。此外，转换本身需要在

动画中

才能使用本地版本的

θ

您能让我给出的示例生效吗？我试过了，但还是不知道怎么做。非常感谢。需要补充的一点是，

AffineTransform

在旋转后为我们做回平移，因此我使用了它，而不是分3步进行。

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

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