CITE THIS NOTEBOOK: Interwoven torus loops over polyhedra by Sándor Kabai. Wolfram Community OCT 31 2022.
Torus loops are interwoven by placing them in parallel with the faces of various polyhedra , i.e. icosahedron, dodecahedron, truncated icosahedron (TICO). In one configuration 12 + 20 = 32 loops are interwoven. Remember rhombic triacontahedron has 32 vertices, TICO has 32 faces.
In[]:=
fi=GoldenRatio;​​alf=ArcTan[fi];​​bet=ArcTan[1/fi];​​bet1=ArcTan[1/fi^2];​​n=5;​​tor=ParametricPlot3D[{(5+Cos[v])Cos[u],(5+Cos[v])Sin[u],Sin[v]},{u,0,1.9Pi},{v,0,2Pi},MeshNone,BoundaryStyleBlack,PlotStyleFaceForm[Yellow,Red]][[1]];​​loop5=ParametricPlot3D[{(5+Cos[nu])Cos[u],(5+Cos[nu])Sin[u],Sin[nu]},{u,0,2Pi},PlotStyleTube[0.3],ColorFunction"TemperatureMap"][[1]];​​Graphics3D[{tor,loop5},BoxedFalse,SphericalRegionTrue,ImageSize200]
Out[]=
In[]:=
n=6;​​tor=ParametricPlot3D[{(4+Cos[v])Cos[u],(4+Cos[v])Sin[u],Sin[v]},{u,0,1.9Pi},{v,0,2Pi},MeshNone,BoundaryStyleBlack,PlotStyleFaceForm[Yellow,Red]][[1]];​​loop6=ParametricPlot3D[{(5+Cos[nu])Cos[u],(5+Cos[nu])Sin[u],Sin[nu]},{u,0,2Pi},PlotStyleTube[0.3],ColorFunction"BlueGreenYellow"][[1]];​​Graphics3D[{tor,loop6},BoxedFalse,SphericalRegionTrue,ImageSize200]
Out[]=
In[]:=
dod=PolyhedronData["Dodecahedron","Faces"];​​dod1=Scale[dod,5];​​s1=Translate[loop5,{0,0,8}];​​s2=Table[Rotate[Rotate[Rotate[s1,Pi,{0,0,1}],2bet,{0,1,0}],i2Pi/5,{0,0,1}],{i,5}];​​​​Graphics3D[{dod1,s1,s2},BoxedFalse,SphericalRegionTrue,ImageSize300,ViewPoint{0,0,100}]
Out[]=
In[]:=
dod1a=Scale[dod,10];​​s1a=Translate[loop5,{0,0,13}];​​s2a=Table[Rotate[Rotate[Rotate[s1a,Pi,{0,0,1}],2bet,{0,1,0}],i2Pi/5,{0,0,1}],{i,5}];​​​​Graphics3D[{dod1a,s1a,s2a},BoxedFalse,SphericalRegionTrue,ImageSize300,ViewPoint{0,0,100}]
Out[]=
In[]:=
p1=Rotate[Rotate[Translate[loop6,{0,0,13}],Pi/6,{0,0,1}],-alf+bet1,{0,1,0}];​​p5=Table[Rotate[p1,i2Pi/5,{0,0,1}],{i,5}];​​tico=PolyhedronData["TruncatedIcosahedron","Faces"];​​tico1=Scale[tico,5];​​​​Graphics3D[{LightCyan,tico1,s1a,s2a,p1,p5},BoxedFalse,SphericalRegionTrue,ImageSize400,ViewPoint{0,0,100}]
In[]:=
Graphics3D[{LightCyan,tico1,p1,p5},BoxedFalse,SphericalRegionTrue,ImageSize400,ViewPoint{0,0,100}]