Sándor Kabai
Universal deltoidal hexecontahedra
The center of each face of the icosahedron is connected to the midpoints of its edges, thus forming three deltoids. The centers of the faces and the midpoints of the edges are moved radially to produce infinitely many deltoidal hexecontahedra (DH). The snapshots show the DH coinciding with known polyhedra.
Universal deltoidal hexecontahedra
The center of each face of the icosahedron is connected to the midpoints of its edges, thus forming three deltoids. The centers of the faces and the midpoints of the edges are moved radially to produce infinitely many deltoidal hexecontahedra (DH). The snapshots show the DH coinciding with known polyhedra.
In[]:=
Manipulate[ϕ=GoldenRatio;β=ArcTan[1/ϕ];β1=ArcTan[1/ϕ^2];vA={1/ϕ,1,0};vC={-1/ϕ,1,0};vH={0,1/ϕ,1};tr9=Polygon[{vA,vH,vC}];Tz=radiusSin[β1];Ty=radiusCos[β1];αα=ArcTan[(1-Tz)/(Ty-1/ϕ)];a=Tan[β]/(Tan[αα]+Tan[β]);Ny=(1/ϕ)+a;Nx=NyTan[β1];h=aTan[αα];Nz=1-h;vN={Nx,Ny,Nz};vM={-Nx,Ny,Nz};vT={0,Ty,Tz};Oi=Sqrt[Ny^2+Nx^2];Oy=Sqrt[Oi^2+Nz^2];vO={0,Oy,0};d1=Polygon[{vT,vN,vH,vM}];d2=Polygon[{vT,vN,vA,vO}];d3=Polygon[{vT,vO,vC,vM}];tr9fr={Yellow,Opacity[0],tr9};v1={d1,d2,d3,tr9fr};v2=Rotate[v1,Pi,{0,1,0}];v3={v1,v2};v4=Rotate[v3,Pi,{1,0,0}];v5={v3,v4};v6=Rotate[v5,β,{1,0,0}];v7=Table[Rotate[v6,i*2Pi/5,{0,0,1}],{i,5}];Graphics3D[v7,PlotRangeAll,SphericalRegionTrue,BoxedFalse,ImageSize300],{{radius,0.6615,""},{0.33"medial triambic icosahedron",0.6615"medial rhombic triacontahedron",0.9341"icosahedron",1.0704"deltoidal hexecontahedron"}},{{radius,0.6615,""},{1.4793"dodecahedron",2.8025"rhombic hexecontahedron"}},{{radius,0.6615,"radius"},0.2,5},TrackedSymbols{radius}]
Out[]=
In[]:=
ϕ=GoldenRatio;α=ArcTan[ϕ];α1=ArcTan[ϕ^2];β=ArcTan[1/ϕ];β1=ArcTan[1/ϕ^2];r=N[Sqrt[0.5^2+(ϕ/2)^2]];v7={-((1+Sqrt[5])/(2*Sqrt[10-2*Sqrt[5]])),-(1/2),1/Sqrt[10-2*Sqrt[5]]};v8={-((1+Sqrt[5])/(2*Sqrt[10-2*Sqrt[5]])),1/2,1/Sqrt[10-2*Sqrt[5]]};h=N[Sum[ϕ^2*(r/ϕ^n),{n,1,1000}]];s1=Polygon[{v7,v8,{0,0,h}}];s5=Table[Rotate[s1,i*2*(Pi/5),{0,0,1}],{i,5}];ico=GraphicsComplex[PolyhedronData["Icosahedron","VertexCoordinates"],Polygon[PolyhedronData["Icosahedron","FaceIndices"]]];icoedge=Scale[GraphicsComplex[PolyhedronData["Icosahedron","VertexCoordinates"],Line[PolyhedronData["Icosahedron","EdgeIndices"]]],Sum[ϕ^2*(r/ϕ^n),{n,1,fr}]*{1,1,1},{0,0,0}];fr=6;icov=Table[Rotate[Translate[Scale[ico,(1/ϕ^i)*{1,1,1},{0,0,0}],Sum[ϕ^2*(r/ϕ^n),{n,1,i}]*{0,0,1}],0*i*(Pi/5),{0,0,1}],{i,fr}];icot=Table[Rotate[Translate[Scale[ico,(1.01/ϕ^i)*{1,1,1},{0,0,0}],Sum[ϕ^2*(r/ϕ^n),{n,1,i}]*{0,0,1}],Pi/5,{0,0,1}],{i,fr}];icot5={Yellow,Table[Rotate[Rotate[{icot},2*β,{0,1,0}],i*2*(Pi/5),{0,0,1}],{i,5}]};s55=Table[Rotate[Rotate[Rotate[{s5},Pi,{0,0,1}],2*β,{0,1,0}],i*2*(Pi/5),{0,0,1}],{i,5}];bottom=Rotate[{icov,icot5},Pi,{0,1,0}];cover=Rotate[{s5,s55},Pi,{0,1,0}];mti={s1,icov,icot5,s55,cover,Yellow,bottom};Graphics3D[{mti},Boxed->False,SphericalRegion->True,ImageSize300]
Out[]=
In[]:=
ϕ=GoldenRatio;α=ArcTan[ϕ];β=ArcTan[1/ϕ];vE={-1/ϕ^2,0,0};vF={0,-1/ϕ,0};vG={ϕ,0,0};vH={0,1/ϕ,0};w1={vE,vF,vG,vH,vE};w2=0.6{vE,vF,vG,vH,vE};w=Polygon[{w1}];p1=Translate[w,{1,0,ϕ}];p2=Rotate[p1,Pi,{0,0,1}];p3=Rotate[{p1,p2},Pi,{0,1,0}];p4=Rotate[Rotate[{p1,p2,p3},Pi/2,{0,1,0}],Pi/2,{0,0,1}];p5=Rotate[Rotate[{p1,p2,p3},Pi/2,{1,0,0}],Pi/2,{0,0,1}];mrt=Table[Rotate[Rotate[{p1,p2,p3,p4,p5},-β,{1,0,0}],i2Pi/5,{0,0,1}],{i,5}];Graphics3D[{mrt},BoxedFalse,ViewPoint{0,0,100},ViewAngle0.01,SphericalRegionTrue,ImageSize200]
Out[]=
In[]:=
ico=PolyhedronData["Icosahedron","Faces"];dod=PolyhedronData["Dodecahedron","Faces"];rh=PolyhedronData["RhombicHexecontahedron","Faces"];dh=PolyhedronData["DeltoidalHexecontahedron","Faces"];