RD faces covered with RT
Sándor Kabai
Interwoven RTs can cover the faces of RD.
In[]:=
cub=PolyhedronData["Cube","Faces"];​​uu=1/Sqrt[2];​​gam=ArcTan[Sqrt[2]];​​delt=Pi/2-gam;​​x=Cos[gam];​​y=Sin[gam];​​vA={x,0,0};​​vB={0,y,0};​​vC={-x,0,0};​​vD={0,-y,0};​​r01={vA,vB,vC,vD};​​(*Setperforate"rdp"here*)​​rdp=0.8;​​r02=rdp{vA,vB,vC,vD};​​r0=Polygon[Join[r01->r02]];​​r1=Translate[{r0},{0,0,y}];​​r2=Table[Rotate[{r1},i2Pi/4+Pi/4,{1,0,0}],{i,4}];​​r3=Rotate[r2,Pi/2+0.001,{0,0,1}];​​r4=Rotate[{r2},Pi/2+0.001,{0,1,0}];​​rdfr0=Rotate[{r2,r3,r4},Pi/4,{0,0,1}];​​rdfrcub=Scale[Rotate[rdfr0,Pi/4,{0,0,1}],Sqrt[3]/2];​​Graphics3D[{cub,Cyan,rdfrcub},SphericalRegionTrue,BoxedFalse,ImageSize200]
Out[]=
In[]:=
Manipulate​​fi=GoldenRatio;​​alf=ArcTan[fi];bet=ArcTan[1/fi];​​(*SetRTdistance"rtdist"here.Use1fortheclosedarrangement*)​​rtdist=2;​​u=rtdist(Sin[alf]+Cos[alf]);​​cubv=PolyhedronData["Cube","VertexCoordinates"];​​rt=PolyhedronData["RhombicTriacontahedron","Faces"];​​rtf=Rotate[Rotate[rt,bet,{0,1,0}],Pi/2+0.001,{0,0,1}];​​cub8={Map[Translate[rtf,#]&,(2n+2)ucubv]};​​cubn=Scale[cub,(2n+2)u];​​a1=Table[Translate[rtf,iu{1,1,1}],{i,n+1}];​​a3=Table[Translate[a1,i{-u,u,u}],{i,n+1}];​​a5=Rotate[a3,Pi,{0,0,1}];​​b1=Translate[{a3,a5},{0,0,(-2nu-2u)dist}];​​b2=Rotate[b1,Pi,{1,0,0}];​​c1={b1,b2};​​c2=Rotate[Rotate[c1,Pi/2+0.001,{0,0,1}],Pi/2+0.001,{1,0,0}];​​c3=Rotate[Rotate[c2,Pi/2+0.001,{0,0,1}],Pi/2+0.001,{1,0,0}];​​​​rdfr=Scale[rdfrcub,(2n+2)u];​​​​Graphics3D[{LightPink,rdfr,Yellow,cubn,Green,cub8,Cyan,c1,Pink,c2,Yellow,c3},BoxedFalse,SphericalRegionTrue,ImageSize400,ViewPoint{0,0,100}],{{n,3,"frequency"},0,7,1,RadioButton},​​{{dist,1,"distance of faces"},0,2.3},TrackedSymbolsManipulate,SaveDefinitions->True​​​​
Out[]=
In[]:=
Graphics3D[{Pink,rdfr,Yellow,cubn,Green,cub8},BoxedFalse,SphericalRegionTrue,ImageSize400,ViewPoint{10,3,4}]
Out[]=
In[]:=
Graphics3D[{Pink,rdfr,Yellow,cubn,Green,cub8,Cyan,c1,Pink,c2,Yellow,c3},BoxedFalse,SphericalRegionTrue,ImageSize400,ViewPoint{100,0,100}]
Out[]=
In[]:=
Graphics3D[{Pink,rdfr,Yellow,cubn,Green,cub8,Cyan,c1},BoxedFalse,SphericalRegionTrue,ImageSize400,ViewPoint{100,40,20}]
Out[]=