CITE THIS NOTEBOOK: Pentagonal art template related to rhombic hexecontahedron by Sándor Kabai. Wolfram Community DEC 28 2022.
WOLFRAM DEMONSTRATION PROJECT: Sándor Kabai, “Pentagonal Art Template”, http://demonstrations.wolfram.com/PentagonalArtTemplate/.
The relationship with rhombic hexecontahedron is shown here.
Eight parallel lines are drawn with spacings
ϕ
, 1,
ϕ
, 1,
ϕ
,
ϕ
, 1,
ϕ
, where
ϕ
is the golden ratio. Then more lines are added with the same spacings. These 16 lines plus a central line are repeated 10 times after rotating them by 36 degrees. The intersecting lines produce a network which can be used as a template for establishing various patterns having pentagonal symmetry (e.g., a Penrose tiling). The set of intersection points is similar to the X-ray diffraction pattern of certain quasicrystals.
In[]:=
fi=GoldenRatio;​​alf=ArcTan[fi];​​bet=ArcTan[1/fi];​​bet1=ArcTan[1/fi^2];​​rh=PolyhedronData["RhombicHexecontahedron","Faces"];​​rht=Rotate[rh,-alf+bet1,{0,1,0}];​​rhtt=rht/.Polygon->Tube;​​rtx=Cos[alf];​​rty=Sin[alf];​​vvA={firtx,0,0};​​vvB={0,firty,0};​​vvC={-rtxfi,0,0};​​vvD={0,-rtyfi,0};​​ss1={vvA,vvB,vvC,vvD,vvA};​​ss2=0.85{vvA,vvB,vvC,vvD,vvA};​​rr1=Polygon[Join[ss1->ss2]];​​rh1=Translate[rr1,{0,firty+rty,firty}];​​rh2=Translate[rr1,{0,-firty-rty,firty}];​​rh3=Translate[{rh1,rh2},{0,0,-2rtyfi}];​​rh4=Rotate[Rotate[{rh1,rh2,rh3},Pi/2+0.001,{1,0,0}],Pi/2,{0,1,0}];​​rh5=Rotate[Rotate[{rh1,rh2,rh3},Pi/2+0.001,{0,1,0}],Pi/2,{1,0,0}];​​rh0=Table[Rotate[Rotate[{rh1,rh2,rh3,rh4,rh5},bet,{1,0,0}],i2Pi/5,{0,0,1}],{i,5}];​​rhp=Rotate[Rotate[Scale[rh0,1],-alf+bet1,{0,1,0}],Pi/8,{0,0,1}];​​Graphics3D[{rh0},ImageSize400,ImageSizeTiny,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
ϕ=GoldenRatio;​​u=24;​​w1={Thickness[0.0005],Line[{{{0,-u,0},{0,u,0}},{{ϕ,-u,0},{ϕ,u,0}},{{ϕ+1,-u,0},{ϕ+1,u,0}},{{2ϕ+1,-u,0},{2ϕ+1,u,0}},{{2ϕ+2,-u,0},{2ϕ+2,u,0}},{{3ϕ+2,-u,0},{3ϕ+2,u,0}},{{4ϕ+2,-u,0},{4ϕ+2,u,0}},{{4ϕ+3,-u,0},{4ϕ+3,u,0}},{{5ϕ+3,-u,0},{5ϕ+3,u,0}}}]};​​w2=Translate[w1,{5ϕ+3,0,0}];​​w={w1,w2};w5=Table[Rotate[w,i2Pi/10,{0,0,1}],{i,10}];​​x=5ϕ+3;​​y=xTan[2Pi/20];​​vA={x,y,0};​​d=Sqrt[x^2+y^2];​​vB={x,y+d,0};​​vC={0,d,0};​​vD={0,0,0};​​vE={0,d+2y,0};​​vF={-x,y+d,0};​​p1={Thickness[0.005],Line[{vD,vA,vB,vC}]};​​star=Table[Rotate[p1,i2Pi/5,{0,0,1}],{i,5}];​​pe1={Thickness[0.005],Line[{vB,vE,vF}]};​​dec=Table[Rotate[pe1,i2Pi/5,{0,0,1}],{i,5}];​​(*Firstsetoflines->w1*)​​rhpn=Rotate[Scale[rh0,5],0×2Pi,{0,0,1}];​​rhpn1=Rotate[rhpn,alf-bet1,{1,0,0}];​​Graphics3D[{w1,Red,dec,Blue,star},ImageSize300,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
Graphics3D[{w1,Red,dec,Blue,star,Yellow,rhpn},ImageSize400,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
(*Firstandsecondsetoflines*)​​Graphics3D[{w1,w2,dec,star,rhpn},ImageSize400,ImageSizeTiny,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
(*Tentimesthe1stand2ndsetsofines*)​​Graphics3D[{w5,Pink,rhpn},ImageSize500,ImageSizeTiny,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=