How to hollow out this surface?
Using ColorReplace[]
to inject transparency into a texture is very useful for this sort of thing:
sierp = ColorReplace[Rasterize[Show[MengerMesh[4, MeshCellStyle -> {{1, All} -> Gray,
{2, All} -> Gray}],
ImagePadding -> None, PlotRangePadding -> None],
RasterSize -> 600], White];
ParametricPlot3D[{Sqrt[u^2 - 1] Cos[v], Sqrt[u^2 - 1] Sin[v], -u},
{u, -8, 8}, {v, 0, 2 π}, Axes -> False, Boxed -> False,
PlotStyle -> {Texture[sierp]}, Mesh -> None]
Expanding cvgmt's answer, there is a perfect result within 10 seconds in my macbook.
Let's unwrap uv to plane,[Here is done by Sow/Reap u,v] and then choose polygons in Region.
reg=TransformedRegion[MengerMesh[4],{Rescale[Indexed[#,1],{0,1},{0,2Pi}],Rescale[Indexed[#,2],{0,1},{0,\[Pi]}]}&]
AbsoluteTiming[c=0;r=Reap[surf=ParametricPlot3D[{Cos[u]Sin[v],Cos[u]Cos[v],Sin[u]}(*{Sqrt[u^2-1] Cos[v],Sqrt[u^2-1] Sin[v],-u}*),{u,0,2\[Pi]},{v,0,\[Pi]},RegionFunction->Function[{x,y,z,u,v},Sow[{{x,y,z},{u,v}}];True],PlotPoints->100,MaxRecursion->2,Boxed->False,Axes->False,Mesh->False,ColorFunction->(ColorData["Rainbow"][#2]&)]];]
pts=Flatten[r[[2,1]][[All,1]],0];
pts//Length
uv=r[[2,1]][[All,2]];
uv//Length
AbsoluteTiming[tfList=RegionMember[reg,uv];]
tfList//Counts
pts2Plot=Pick[pts,tfList];
mesh=DiscretizeGraphics@r[[1]];
polygons=MeshPrimitives[mesh,2];
polygons//Length
meshPoint=DiscretizeGraphics@Graphics3D[Point/@pts2Plot];
AbsoluteTiming[polygons2Use=Select[polygons[[1;;-1]],Or@@RegionMember[meshPoint,#[[1]]]&];]
Graphics3D[{EdgeForm[],polygons2Use,Red,meshPoint}]
Update
The above method is limited, since the sampling problem of ParametricPlot3D
So we can plot it with Graphics3D
reg=MengerMesh[4,DataRange->{{-8,8},{0,2\[Pi]}}];
polygons=MeshCells[reg,2];
coo=MeshCoordinates[reg];
pts2Use=Table[{u,v}=p;{Sqrt[u^2-1] Cos[v],Sqrt[u^2-1] Sin[v],-u},{p,coo}];
pts2UseReal=If[AnyTrue[Head/@#,#===Complex&],{0,0,0},#]&/@pts2Use;
gc=GraphicsComplex[pts2UseReal,polygons];
Graphics3D@gc
You can simply add the option Background -> None
in Rasterize
:
mm = Rasterize[MengerMesh[4, MeshCellStyle -> {{1, All} -> Gray, {2, All} -> Gray},
ImagePadding -> None, PlotRangePadding -> None],
RasterSize -> 900, Background -> None];
ParametricPlot3D[{Sqrt[u^2 - 1] Cos[v], Sqrt[u^2 - 1] Sin[v], -u},
{u, -8, 8}, {v, 0, 2 π},
Axes -> False, Boxed -> False, PlotStyle -> Texture[mm], Mesh -> None]
Use Texture[ImageMultiply[mm, RGBColor[0, 0, 1, .5]]]
to get