Sliding cubes
Sliding cubes
Sándor Kabai
Cubes are aligned side by side and then slid along their faces. Since the cube is divided into an octahedral part and a tetrahedral part, it is possible to show how octahedra and tetrahedra can be slid along one another. Also, the same arrangement is valid for rhombohedra, if one diagonal of the cube is varied, possibly even to zero.
See: https://demonstrations.wolfram.com/SlidingCubes/
Cubes are aligned side by side and then slid along their faces. Since the cube is divided into an octahedral part and a tetrahedral part, it is possible to show how octahedra and tetrahedra can be slid along one another. Also, the same arrangement is valid for rhombohedra, if one diagonal of the cube is varied, possibly even to zero.
See: https://demonstrations.wolfram.com/SlidingCubes/
In[]:=
Manipulate[Module[{u,vA,vB,vC,vD,vE,vF,vT,vU,t1,t2,s1,s2,s3,s4,s5,s6,u1,u2,u3,tet,oct,ocy,ocx},u=0.5Sqrt[3]/3;vA={0.5,-u,0};vB={0,2u,0};vC={-0.5,-u,0};vD={0,-2u,h};vE={0.5,u,h};vF={-0.5,u,h};vT={0,0,2h};vU={0,0,-h};t1=Polygon[{vA,vB,vC}];t2=Polygon[{vD,vE,vF}];s1=Polygon[{vA,vE,vT,vD}];s2=Polygon[{vB,vF,vT,vE}];s3=Polygon[{vA,vE,vB}];s4=Polygon[{vB,vF,vC}];s5=Polygon[{vF,vC,vD,vT}];s6=Polygon[{vA,vC,vD}];u1=Polygon[{vA,vB,vU}];u2=Polygon[{vA,vC,vU}];u3=Polygon[{vC,vB,vU}];tet={u1,u2,u3};oct={t1,s1,s2,s3,s4,s5,s6};ocy=Table[Translate[{If[octs,oct,{}],If[tets,tet,{}]},{-is,iSqrt[3]/2,0}],{i,n}];ocx=Table[Translate[ocy,{i(1-(0.5-s)Sin[Pi/6]),-i(0.5-s)Cos[Pi/6],0}],{i,n}];Graphics3D[Table[Rotate[{RGBColor[1,0.3,0.3],ocy,RGBColor[0.3,1,1],ocx,RGBColor[1,1,0],oct,tet},i2Pi/3,{0,0,1}],{i,3}],SphericalRegionTrue,BoxedFalse,ImageSize400,ViewPoint{0,0,-100}]],Row[{Control[{{s,0,"slide"},0.5,-0.5,Appearance"Labeled",ImageSizeTiny}],Control[{{h,0.408,"diagonal size"},0,1,Appearance"Labeled",ImageSizeTiny}],Control[{{n,2," frequency"},1,4,Appearance"Labeled",ImageSizeTiny}]}],Row[{Control[{{octs,True,"show octet"},{True,False}}],Spacer[50],Control[{{tets,True,"show tet"},{True,False}}]}],TrackedSymbols{s,h,n,octs,tets},ControlPlacement->Top]
Out[]=

