Menger sponge and its voids
Kabai Sándor
Menger sponge modeling: place 8 cubes at the vertices of a cube, and 12 cubes at the vertices of a cuboctahedron. Take this unit of 20 cubes and repeat the procedure. An assembly is created, which fills the voids of the sponge. Actually, 20 cubes are arranged along the edges of a larger cube. This is repeated for the larger cube to create a fractal. As these steps increase, the volume of the sponge converges to zero
Menger sponge modeling: place 8 cubes at the vertices of a cube, and 12 cubes at the vertices of a cuboctahedron. Take this unit of 20 cubes and repeat the procedure. An assembly is created, which fills the voids of the sponge. Actually, 20 cubes are arranged along the edges of a larger cube. This is repeated for the larger cube to create a fractal. As these steps increase, the volume of the sponge converges to zero
In[]:=
cub=PolyhedronData["Cube","Faces"];c1=Table[Rotate[Translate[cub,{1,0,0}],i2Pi/4,{0,0,1}],{i,4}];c2=Table[Rotate[Translate[cub,{0,0,1}],i2Pi/2,{1,0,0}],{i,2}];k1={c1,c2};Graphics3D[{k1},Boxed->False,SphericalRegion->True,ImageSize->200]
Out[]=
In[]:=
k2=Scale[k1,1/3];Graphics3D[{k2,cub},Boxed->False,SphericalRegion->True];
cubv=cub[[1]];cuboc=PolyhedronData["Cuboctahedron","Faces"];cubocv=cuboc[[1]];k8=Map[Translate[k2,#]&,2cubv];k12=Rotate[Map[Translate[Rotate[k2,Pi/4,{0,0,1}],#]&,Sqrt[2]cubocv],Pi/4,{0,0,1}];u1=Scale[{RGBColor[0.7,0.7,1],k8,Yellow,k12},1/3];Graphics3D[{u1},Boxed->False,SphericalRegion->True]
In[]:=
u2={k2,u1};Graphics3D[{u2},Boxed->False,SphericalRegion->True]
Out[]=
In[]:=
u8=Map[Translate[u2,#]&,2cubv];u12=Rotate[Map[Translate[Rotate[u2,Pi/4,{0,0,1}],#]&,Sqrt[2]cubocv],Pi/4,{0,0,1}];v1=Scale[{u8,u12},1/3];Graphics3D[{k2,v1},Boxed->False,SphericalRegion->True,ViewPoint->{1000,1000,1000},ImageSize->400]
Out[]=
In[]:=
cub8=Map[Translate[cub,#]&,2cubv];cub12=Rotate[Map[Translate[Rotate[cub,Pi/4,{0,0,1}],#]&,Sqrt[2]cubocv],Pi/4,{0,0,1}];u1=Scale[{RGBColor[0.7,0.9,0.8],cub8,RGBColor[1,0.9,0.8],cub12},1/3];Graphics3D[{u1},Boxed->False,SphericalRegion->True]
Out[]=
In[]:=
v8=Map[Translate[u1,#]&,2cubv];v12=Rotate[Map[Translate[Rotate[u1,Pi/4,{0,0,1}],#]&,Sqrt[2]cubocv],Pi/4,{0,0,1}];v2=Scale[{v8,v12},1/3];Graphics3D[{v2},Boxed->False,SphericalRegion->True,ViewPoint->{0,0,0.83},ImageSize->300]
Out[]=
In[]:=
Graphics3D[{v2},Boxed->False,SphericalRegion->True,ImageSize->300]
Out[]=
In[]:=
Graphics3D[{u2,v2},Boxed->False,SphericalRegion->True,ImageSize->300]
Out[]=
