point4D = {{-1,-1,-1,-1},{-1,-1,-1,1},{-1,-1,1,-1},{-1,-1,1,1},{-1,1,-1,-1},{-1,1,-1,1},{-1,1,1,-1},{-1,1,1,1},{1,-1,-1,-1},{1,-1,-1,1},{1,-1,1,-1},{1,-1,1,1},{1,1,-1,-1},{1,1,-1,1},{1,1,1,-1},{1,1,1,1}} ; (*頂点*)
side4D = {{1,2},{1,3},{1,5},{1,9},{2,4},{2,6},{2,10},{3,4},{3,7},{3,11},{4,8},{4,12},{5,6},{5,7},{5,13},{6,8},{6,14},{7,8},{7,15},{8,16},{9,10},{9,11},{9,13},{10,12},{10,14},{11,12},{11,15},{12,16},{13,14},{13,15},{14,16},{15,16}} ; (*辺*)
plane4D = {{1,2,4,3},{1,2,6,5},{1,2,10,9},{1,3,7,5},{1,3,11,9},{1,5,13,9},{2,4,8,6},{2,4,12,10},{2,6,14,10},{3,4,8,7},{3,4,12,11},{3,7,15,11},{4,8,16,12},{5,6,8,7},{5,6,14,13},{5,7,15,13},{6,8,16,14},{7,8,16,15},{9,10,12,11},{9,10,14,13},{9,11,15,13},{10,12,16,14},{11,12,16,15},{13,14,16,15}} ;(*面*)

tesseract = GraphicsComplex[(*正八胞体*)
point4D,
{{JoinForm["Round"],Tube[side4D,0.20]},
{Directive[EdgeForm[]],Opacity[0.125],Polygon[plane4D]}}] ;


With[{matrix4D = IdentityMatrix[4]},
Animate[
Graphics3D[{ColorData["Legacy","Pink"],
MapAt[(*射影変換*)
Map[Composition[
Function[x,2 Delete[x,2] / (2 - Extract[x,2])],
Composition[RotationTransform[θ,matrix4D[[{1,2}]]],RotationTransform[θ,matrix4D[[{4,3}]]]]],
#]&,tesseract,{1}]},
Background->Black,Boxed->False,Lighting->"Neutral",PlotRange->{{-5,5},{-5,5},{-5,5}},PlotRangePadding->None,ViewPoint->{2.0,-2.0,1.0}],{θ,0,2π,2π/100}]] 

(*gif化*)
gifs = {};
Do[
gif = With[{matrix4D = IdentityMatrix[4]},
Graphics3D[{ColorData["Legacy","Pink"],
MapAt[(*射影変換*)
Map[Composition[
Function[x,2 Delete[x,2] / (2 - Extract[x,2])],
Composition[RotationTransform[θ,matrix4D[[{1,2}]]],RotationTransform[θ,matrix4D[[{4,3}]]]]],
#]&,tesseract,{1}]},
Background->Black,Boxed->False,Lighting->"Neutral",PlotRange->{{-5,5},{-5,5},{-5,5}},PlotRangePadding->None,ViewPoint->{2.0,-2.0,1.0}]];
AppendTo[gifs,gif],{θ,0,2π,2π/100}]
Export["animation.gif",gifs]