# Create a square polygon that can be used as the base of a pyramid

For example I want to use the design generated by this code as the base of a pyramid as well as other iterations of the design

carpet[n_] := Nest[ArrayFlatten[{{#, #, #}, {#, 0, #}, {#, #, #}}] &, 1, n]

ArrayPlot[carpet[2], PixelConstrained -> 40]


• Sounds like you're looking for Texture and VertexTextureCoordinates. Related. Commented Mar 30, 2016 at 14:12
• True except I want to then 3D print this object and have the design as a physical aspect not simply a picture Commented Mar 30, 2016 at 14:20
• @ayrnee So, you want to generate the same patern in 3D in a pyramid or only on the base of the pyramid (not sure to understand)? Commented Mar 30, 2016 at 14:55

Building off of Dr. belisarius's answer: is this what you're looking for?

n = 20;
i = ImageResize[ColorNegate@Image[carpet[2]], n]
pixpos = PixelValuePositions[i, 0.];
pyramids = Pyramid[{Append[# + {1/2, 1/2}, 0], Append[# + {1/2, -1/2}, 0],
Append[# + {-1/2, -1/2}, 0], Append[# + {-1/2, 1/2}, 0],
{(n + 1)/2, (n + 1)/2, -n}}] & /@ pixpos;

Graphics3D[{EdgeForm[None], pyramids}]


There's probably a more efficient way of doing this rather than using all those Append's, but I have to run and can't improve this just now.

• This is exactly what I am looking for but when I try to move this code into mathematica to use it I get a boatload of errors Commented Apr 4, 2016 at 11:32
• @ayrnee: Fixed it. I should have been using Append instead of AppendTo. Commented Apr 4, 2016 at 13:35
• Perfect that is so much help. But I am now having issues when I try the arguments 3,4 and 5 for carpet which I need to complete this project. For some reason they show a pyramid but without any design on the base Commented Apr 4, 2016 at 14:09
• n represents the number of "pixels" in the base. You'll need to increase it if you want to do a higher-resolution design on the base. For carpet[3], carpet[4], and carpet[5], you'll probably want to set $n$ equal to $3^3$, $3^4$, or $3^5$ respectively. This code may start to get pretty unwieldy for the last of these. Commented Apr 4, 2016 at 14:13

Perhaps something like this:

i = ImageResize[ColorNegate@Image[carpet[2]], 300]
j = Join[{#, 0} & /@ PixelValuePositions[i, 0.], {#, 1} & /@   PixelValuePositions[i, 1.]];
g = Interpolation[j, InterpolationOrder -> 0];

RegionPlot3D[z < x + y && g[x, y] == 0, {x, 1, 300}, {y, 1, 300}, {z, 1, 300},
PlotPoints -> 50, Mesh -> None]


or perhaps

i = ImageResize[ColorNegate@Image[carpet[2]], 20];
o = Flatten /@ Tuples[{PixelValuePositions[i, 0.], Range@20}];
Graphics3D[{EdgeForm[None], (Cuboid[{##}] & @@@ o)}, Boxed -> False]


s = 100;
i = ImageResize[ColorNegate@Image[carpet[2]], s];
t = Table[Thread[{Select[PixelValuePositions[i, 0.], Max[Abs[(s + 1)/2 - #] & /@ #] < j &], j}],
{j, IntegerPart[(s + 1)/2]}];
Graphics3D[{EdgeForm[None], Cuboid @@ {#} & /@ Flatten /@ Flatten[t, 1]}]


• Perhaps like the cube, but with pyramid (pyramid with holes from the base)? Commented Mar 30, 2016 at 16:07
mm = MengerMesh[2];

meshcoords = Append[Append[0] /@ #, Append[1] @ Mean @ #] & @ MeshCoordinates[mm];

prims = Pyramid[Append[Length @ meshcoords] @ #] & /@ MeshCells[mm, 2][[All, 1]];

mengerPyramid = MeshRegion[meshcoords, prims, PlotTheme -> "Polygons"]


Use mm = MengerMesh[3] above to get