Pentagonal art template
Pentagonal art template
by Sándor Kabai
Pentagonal Art Template - Wolfram Demonstrations Project
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.
Pentagonal Art Template - Wolfram Demonstrations Project
Eight parallel lines are drawn with spacings
ϕ
ϕ
ϕ
ϕ
ϕ
ϕ
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*)Graphics3D[{w1,dec,star},ImageSize300,ImageSizeTiny,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
(*Firstandsecondsetoflines*)Graphics3D[{w1,w2,dec,star},ImageSize300,ImageSizeTiny,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
(*Tentimesthe1stand2ndsetsofines*)Graphics3D[{w5,star},ImageSize500,ImageSizeTiny,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
fi=GoldenRatio;k=fiTan[2Pi/20];m=rCos[2Pi/10];r=k/Sin[2Pi/10];frame=Table[{rSin[i2Pi/5],rCos[i2Pi/5],0},{i,6}];f1={Thickness[0.004],Line[frame]};f2=Translate[f1,{0,m+fi,0}];ten=Table[Rotate[f2,i2Pi/10+Pi/10,{0,0,1}],{i,10}];(*Ringoftenpentagons*)Graphics3D[{ten},BoxedFalse,ImageSize200,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
In[]:=
ten1=Scale[ten,fi];ten2=Scale[ten,fi^2];ten3=Scale[ten,fi^3];ten4=Scale[ten,fi^4];tenup=Translate[ten,{vE}];tenup10=Table[Rotate[tenup,i2Pi/10,{0,0,1}],{i,10}];tenup1=Translate[ten,{0,d,0}];spA=Sphere[vA];spB=Sphere[vB];spC=Sphere[vC];spD=Sphere[vD];spE=Sphere[vE];spF=Sphere[vF];vG={x,-y,0};spG=Sphere[vG];vA={x,y,0};vB={x,y+d,0};dis=(d+2y)Cos[2Pi/20];vH={dis,yfi,0};spH=Sphere[vH];pit=Polygon[{vC,vG,vB,vD,vH,vC}];pit1=Rotate[pit,3Pi/5,{0,0,1},{0,0,0}];pit2=Rotate[pit,6Pi/5,{0,0,1},{0,0,0}];Graphics3D[{{dec,Yellow,spE,Blue,spF},{Green,spA,spB,spC,spD},{Red,spG,spH},tenup1,pe1,tenup10,ten,{Blue,star},w5,ten3,Red,ten4,pit,pit1,pit2},ImageSize500,ImageSizeTiny,BoxedFalse,SphericalRegionTrue,ViewPoint{0,0,100}]
Out[]=
