Truncated icosahedron with decorated surface
Sándor Kabai
The pentagonal and hexagonal faces of truncated icosahedron (TICO) are substituted with matching graphics to show decorated surfaces.
The pentagonal and hexagonal faces of truncated icosahedron (TICO) are substituted with matching graphics to show decorated surfaces.
In[]:=
fi=GoldenRatio;alf=ArcTan[fi];bet=ArcTan[1/fi];bet1=ArcTan[1/fi^2];
In[]:=
(*Pentagon*)r5=0.5/Sin[2Pi/10];p5v=Table[r5{Sin[i2Pi/5+Pi/10],Cos[i2Pi/5+Pi/10],0},{i,5}];pent=Polygon[p5v];pent1=Translate[{pent},{0,0,2.326}];pent5=Table[Rotate[Rotate[Rotate[pent1,Pi,{0,0,1}],2bet,{0,1,0}],i2Pi/5,{0,0,1}],{i,5}];pent6=Rotate[{pent1,pent5},Pi,{0,1,0}];pent12={pent1,pent5,pent6};tico=PolyhedronData["TruncatedIcosahedron","Faces"];ticon=Scale[tico,0.999{1,1,1},{0,0,0}];ticont=ticon/.Polygon->Tube;Graphics3D[{Cyan,ticont,Pink,pent12},BoxedFalse,ImageSize300,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
(*Hexagon*)r6=0.5/Sin[2Pi/12];p6v=Table[r6{Sin[i2Pi/6],Cos[i2Pi/6],0},{i,6}];hex=Polygon[p6v];i1={hex};i2=Rotate[Translate[i1,{1.5Sqrt[3]/3,0,0}],bet1,{0,1,0}];i3=Rotate[i2,Pi,{0,0,1}];i4=Table[Rotate[Rotate[Translate[{i2,i3},{0,0,fi1.5}],-alf,{0,1,0}],i2Pi/5,{0,0,1}],{i,5}];i5=Rotate[i4,Pi,{0,1,0}];hex30={i4,i5};Graphics3D[{Cyan,hex30,Yellow,ticont},BoxedFalse,ImageSize300,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
Create matching graphics (an example)
In[]:=
(*Substitutethepentagon*)fi=GoldenRatio;r=0.5/Sin[2Pi/10];m=0.5/Tan[2Pi/10];h=0.5/Tan[2Pi/20];frame=Table[{rSin[i2Pi/5],rCos[i2Pi/5],0},{i,6}];hole=0.6Table[{rSin[i2Pi/5],rCos[i2Pi/5],0},{i,6}];f1=Polygon[frame->hole];f2=Translate[f1,{0,h+m,0}];f5=Table[Rotate[f2,i2Pi/5,{0,0,1}],{i,5}];fin5=Table[{Hue[0.4^2i],Rotate[Scale[f5,1/fi^i{1,1,1},{0,0,0}],i2Pi/10,{0,0,1}]},{i,4}];(*Reducethesizetofitthepentasgon*)insert5=Rotate[Scale[fin5,1/2.236{1,1,1},{0,0,0}],Pi/2,{0,0,1}];Graphics3D[{pent,insert5},BoxedFalse,ImageSize300,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
(*Substitutethehexagon*)h1=Map[Translate[hex,#]&,2p6v];h2=Map[Translate[h1,#]&,2p6v];(*Reducethesizetofitthehexagon*)insert6=Scale[h2,0.19{1,1,1},{0,0,0}];Graphics3D[{Cyan,insert6,Yellow,hex},BoxedFalse,ImageSize300,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
pent1=Translate[{insert5},{0,0,2.326}];pent5=Table[Rotate[Rotate[Rotate[pent1,Pi,{0,0,1}],2bet,{0,1,0}],i2Pi/5,{0,0,1}],{i,5}];pent6=Rotate[{pent1,pent5},Pi,{0,1,0}];pent12={pent1,pent5,pent6};Graphics3D[{ticont,pent12},BoxedFalse,ImageSize300,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
