Wolfram Function Repository

Instant-use add-on functions for the Wolfram Language

Function Repository Resource:

 PerforatePolygons

Source Notebook

Make a hole in the middle of a polygon

Contributed by: Wolfram Research

ResourceFunction["PerforatePolygons"][gr]

creates a hole in the middle of each polygon in the 3D graphics gr.

ResourceFunction["PerforatePolygons"][gr,r]

create a hole of size r, where r is the ratio of the hole size to the polygon size.

ResourceFunction["PerforatePolygons"][gr,"type"]

decomposes into polygons of the specified "type" before creating holes.

Details

The default hole ratio is one half.
Each holed polygon is formed by a number of polygons equivalent to the number of sides of the original polygon.
ResourceFunction["PerforatePolygons"] works with primitives that are decomposable in polygons like Polyhedron.
ResourceFunction["PerforatePolygons"] works best when each surface in gr is a planar convex polygon.
Possible "type" specifications include:
"Simple"simple polygons
"Convex"convex polygons
"Triangle"triangles

Examples

Basic Examples (4) 

A set of polygons:

In[1]:=
Graphics[Table[{EdgeForm[Black], Hue[RandomReal[]], Polygon[RandomReal[1, {3, 2}]]}, {10}]] // ResourceFunction[ "PerforatePolygons"]
Out[1]=

Random polygons:

In[2]:=
Graphics[Table[{EdgeForm[Black], Opacity[.5], Hue[RandomReal[]], RandomPolygon[spec]}, {spec, {"Convex", "Simple", "StarShaped", "ConvexHull", 2 -> 10}}]] // ResourceFunction[ "PerforatePolygons"]
Out[2]=

A polyhedron:

In[3]:=
Graphics3D[ Polygon /@ {{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}, {{0, 1, 0}, {1, 0, 0}, {0, 0, 0}}, {{0, 0, 1}, {0, 0, 0}, {1, 0, 0}}, {{0, 0, 0}, {0, 0, 1}, {0, 1, 0}}}] // ResourceFunction["PerforatePolygons"]
Out[3]=
In[4]:=
ResourceFunction["PerforatePolygons"]@ Graphics3D[{Red, Polyhedron[{{0., 2^Rational[-1, 2], 0.}, {2^Rational[-1, 2], 0., 0.}, {0., -2^Rational[-1, 2], 0.}, {-2^Rational[-1, 2], 0., 0.}, {0., 0., 2^Rational[-1, 2]}, {0., 0., -2^Rational[-1, 2]}}, {{5, 2, 1}, {5, 3, 2}, {5, 4, 3}, {4, 5, 1}, {2, 6, 1}, {2, 3, 6}, {4, 6, 3}, {1, 6, 4}}]}]
Out[4]=

Another polyhedron:

In[5]:=
PolyhedronData["Dodecahedron"] // ResourceFunction[ "PerforatePolygons"]
Out[5]=

Make smaller holes:

In[6]:=
ResourceFunction["PerforatePolygons"][ PolyhedronData["Dodecahedron"], .2]
Out[6]=

Scope (14) 

With offsets:

In[7]:=
ResourceFunction["PerforatePolygons"][ Graphics[Polygon[{Offset[{10, 10}, {0, 0}], Offset[{0, -20}, {.5, 1}], Offset[{-10, 10}, {1, 0}]}], Frame -> True]]
Out[7]=

With Scaled:

In[8]:=
Graphics[Polygon[{Scaled[{0, 0}], Scaled[{.5, 1}], Scaled[{1, 0}]}], Frame -> True] // ResourceFunction["PerforatePolygons"]
Out[8]=

With ImageScaled:

In[9]:=
Graphics[Polygon[{ImageScaled[{0, 0}], ImageScaled[{.5, 1}], ImageScaled[{1, 0}]}], Frame -> True] // ResourceFunction[ "PerforatePolygons"]
Out[9]=

A square with a hole with another square inside:

In[10]:=
ResourceFunction["PerforatePolygons"][ Graphics[{EdgeForm[Blue], FaceForm[Pink], Polygon[{{-0.7778174593052023, -0.7778174593052023}, {-0.7778174593052023, 0.7778174593052023}, {-0.5185449728701348, -0.5185449728701348}, {-0.5185449728701348, 0.5185449728701348}, {-0.2592724864350674, -0.2592724864350674}, {-0.2592724864350674, 0.2592724864350674}, { 0.2592724864350674, -0.2592724864350674}, {0.2592724864350674, 0.2592724864350674}, {0.5185449728701348, -0.5185449728701348}, { 0.5185449728701348, 0.5185449728701348}, { 0.7778174593052023, -0.7778174593052023}, {0.7778174593052023, 0.7778174593052023}}, {{1, 11, 12, 2} -> {{4, 10, 9, 3}}, {5, 7, 8, 6}}]}], 0.5]
Out[10]=

Sometimes different triangulations can be produced:

In[11]:=
ResourceFunction["PerforatePolygons"][ Graphics[{EdgeForm[Blue], FaceForm[Pink], Polygon[{{-0.7778174593052023, -0.7778174593052023}, {-0.7778174593052023, 0.7778174593052023}, {-0.5185449728701348, -0.5185449728701348}, {-0.5185449728701348, 0.5185449728701348}, {-0.2592724864350674, -0.2592724864350674}, {-0.2592724864350674, 0.2592724864350674}, { 0.2592724864350674, -0.2592724864350674}, {0.2592724864350674, 0.2592724864350674}, { 0.5185449728701348, -0.5185449728701348}, {0.5185449728701348, 0.5185449728701348}, { 0.7778174593052023, -0.7778174593052023}, {0.7778174593052023, 0.7778174593052023}}, {{1, 11, 12, 2} -> {{4, 10, 9, 3}}, {5, 7, 8, 6}}]}], 0.5, #1] & /@ {"Simple", "Convex", "Triangle"} /. EdgeForm[] -> EdgeForm[Blue]
Out[11]=

PolygonDecomposition can be used:

In[12]:=
Graphics[{EdgeForm[Blue], FaceForm[Pink], Opacity[.5], ResourceFunction["PerforatePolygons"][ PolygonDecomposition[ Polygon[{{0, 0}, {3, 0}, {3, 1}, {1, 1}, {1, 2}, {3, 2}, {3, 3}, {0, 3}}], #], .5, #]}] & /@ {"Simple", "Convex", "Triangle"} /. EdgeForm[] -> EdgeForm[Blue]
Out[12]=

Starting with a polygon with holes:

In[13]:=
Graphics[ResourceFunction["PerforatePolygons"][ Polygon[{{0.25108506944444453`, 0.8149088541666664}, { 1.190776909722223, 0.5390624999999996}, {0.4268337673611113, 0.16174045138888848`}} -> {{{0.3488715277777778, 0.7177191840277776}, {0.3855902777777778, 0.537749565972222}, { 0.5593532986111113, 0.6467339409722221}, {0.3475043402777778, 0.7208984374999999}}, {{0.4085394965277779, 0.40024956597222205`}, {0.49185112847222234`, 0.26394314236111094`}, {0.692621527777778, 0.41199001736111096`}, {0.4085394965277779, 0.40024956597222205`}}, {{0.7003472222222223, 0.5671766493055554}, {1.0040581597222225`, 0.5478407118055555}, { 0.8719835069444446, 0.4357747395833331}, {0.7003472222222223, 0.5671766493055554}}, {{0.5546223958333335, 0.5832682291666667}, {0.45919053819444455`, 0.47585720486111116`}, {0.7017578125000001, 0.47488064236111094`}, {0.5561089409722223, 0.5842773437499998}}}]]] /. Polygon[p_, rest___] :> Scale[Polygon[p, rest], .9]
Out[13]=

Using entities:

In[14]:=
Entity["Polyhedron", "RhombicHexecontahedron"][ EntityProperty["Polyhedron", "Graphics3D"]] // ResourceFunction[ "PerforatePolygons"]
Out[14]=

A Bohemian dome surface modifying the ratio of perforation:

In[15]:=
bohdom[a_, b_, c_][u_, v_] := {a Cos[u], a Sin[u] + b Cos[v], c Sin[v]}
In[16]:=
ResourceFunction["PerforatePolygons"][ ParametricPlot3D[ Evaluate[bohdom[1, 1, 1][u, v]], {u, -\[Pi], \[Pi]}, {v, -\[Pi], \[Pi]}, Axes -> None, PlotStyle -> Directive[Orange, Specularity[White, 30]], Mesh -> None, PlotPoints -> 18, MaxRecursion -> 0, Boxed -> False], .7]
Out[16]=

PerforatePolygons works with other primitives:

In[17]:=
Graphics3D[ Polyhedron[{{0., 0., 0.6}, {-0.3, -0.5, -0.2}, {-0.3, 0.5, -0.2}, {0.6, 0., -0.2}}, {{2, 3, 4}, {3, 2, 1}, {4, 1, 2}, {1, 4, 3}}]] // ResourceFunction["PerforatePolygons"]
Out[17]=

Convert into a region:

In[18]:=
RegionUnion @@ Cases[%, __Polygon, \[Infinity]]
Out[18]=

Using VertexTextureCoordinates:

In[19]:=
vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}; coords = {{{0, 0, 0}, {0, 1, 0}, {1, 1, 0}, {1, 0, 0}}, {{0, 0, 0}, {1, 0, 0}, {1, 0, 1}, {0, 0, 1}}, {{1, 0, 0}, {1, 1, 0}, {1, 1, 1}, {1, 0, 1}}, {{1, 1, 0}, {0, 1, 0}, {0, 1, 1}, {1, 1, 1}}, {{0, 1, 0}, {0, 0, 0}, {0, 0, 1}, {0, 1, 1}}, {{0, 0, 1}, {1, 0, 1}, {1, 1, 1}, {0, 1, 1}}};
In[20]:=
(* Evaluate this cell to get the example input *) CloudGet["https://www.wolframcloud.com/obj/eb6dcb1e-a3d3-454c-9213-977d0f0a280b"]
Out[20]=

With VertexColors:

In[21]:=
(* Evaluate this cell to get the example input *) CloudGet["https://www.wolframcloud.com/obj/aa264bfc-9419-415c-bf59-9e0bab16a403"]
Out[21]=

Disconnected polyhedra:

In[22]:=
ResourceFunction["PerforatePolygons"][ Graphics3D[ Polyhedron[{{0, 0, 0}, {1, 0, 0}, {0, 1, 0}, {0, 0, 1}, {1, 1, 1}, {2, 1, 1}, {1, 2, 1}, {1, 1, 2}}, {{{1, 2, 3}, {1, 2, 4}, {2, 3, 4}, {1, 3, 4}}, {{5, 6, 7}, {5, 6, 8}, {6, 7, 8}, {5, 7, 8}}}]]]
Out[22]=

A polyhedron with a void:

In[23]:=
(* Evaluate this cell to get the example input *) CloudGet["https://www.wolframcloud.com/obj/d78e3d4d-74de-4c35-b657-467935d847dd"]
Out[23]=

A non-convex polyhedron:

In[24]:=
(* Evaluate this cell to get the example input *) CloudGet["https://www.wolframcloud.com/obj/ee4970bd-d9e1-4119-a482-f5f253a3e793"]
Out[24]=

A polyhedron with scaled coordinates:

In[25]:=
sp = Polyhedron[ Map[Scaled, {{{0.2, 0., 0.3}, {0.2, 0.9, 0.3}, {1, 0.5, 0.3}}, {{0.2, 0.9, 0.3}, {0.2, 0., 0.3}, {0.5, 0.5, 1.}}, {{1, 0.5, 0.3}, {0.5, 0.5, 1.}, {0.2, 0., 0.3}}, {{0.5, 0.5, 1.}, {1, 0.5, 0.3}, {0.2, 0.9, 0.3}}}, {2}]];
In[26]:=
ResourceFunction["PerforatePolygons"][ Graphics3D[{sp, sp /. Scaled[p_] -> p}, Axes -> True]]
Out[26]=

A polyhedron with VertexNormals:

In[27]:=
n = {1, -1, 1};
In[28]:=
Graphics3D[{Yellow, Polyhedron[{{0, 0, Sqrt[2/3] - 1/(2*Sqrt[6])}, {-1/(2*Sqrt[3]), -1/ 2, -1/(2*Sqrt[6])}, {-1/(2*Sqrt[3]), 1/2, -1/(2*Sqrt[6])}, {1/Sqrt[3], 0, -1/(2*Sqrt[6])}}, {{2, 3, 4}, {3, 2, 1}, {4, 1, 2}, {1, 4, 3}}, VertexNormals -> {-n, n, n, n}]}] // ResourceFunction[ "PerforatePolygons"]
Out[28]=

Applications (3) 

A holed hexagonal grid:

In[29]:=
h[x_, y_] := Polygon[Table[ With[{c1 = .25 Cos[(2 \[Pi] k)/6] + x, c2 = .25 Sin[(2 \[Pi] k)/6] + y}, {c1, c2, .5 Sin[.25 c1 c2]}], {k, 7}]]
In[30]:=
Graphics3D[{Yellow, Table[h[3 i + 3/(4 4) ((-1)^(4 j) + 1), (Sqrt[3] j)/2], {i, 1, 3, 1/4}, {j, 1, 6, 1/4}]}, Boxed -> False, Background -> Black, SphericalRegion -> True] // ResourceFunction["PerforatePolygons"]
Out[30]=

Perforate a prism:

In[31]:=
uehp = ResourceFunction["PerforatePolygons"][ Entity["Polyhedron", {"Prism", 6}]["Graphics3D"]]
Out[31]=

Outline the prism:

In[32]:=
uehp // ResourceFunction["OutlinePolygons"]
Out[32]=

Convert polygons to tubes and vertices to spheres:

In[33]:=
vertices = Flatten[Cases[uehp, Polygon[vert_] -> vert, {5}], 1] // Union;
In[34]:=
Show[uehp, Graphics3D[{RGBColor[0.3866666666666667, 0.4177777777777778, 0.63], Sphere[vertices, .035]}]] // ResourceFunction["Graphics3DWireFrame"]
Out[34]=

Nest perforations:

In[35]:=
Nest[ResourceFunction["PerforatePolygons"], Graphics3D[ Polygon /@ {{{1, 1, 1}, {0, 1, 1}, {0, 0, 1}, {1, 0, 1}}, {{1, 1, 1}, {1, 0, 1}, {1, 0, 0}, {1, 1, 0}}, {{1, 1, 1}, {1, 1, 0}, {0, 1, 0}, {0, 1, 1}}, {{0, 1, 1}, {0, 1, 0}, {0, 0, 0}, {0, 0, 1}}, {{0, 0, 0}, {0, 1, 0}, {1, 1, 0}, {1, 0, 0}}, {{0, 0, 1}, {0, 0, 0}, {1, 0, 0}, {1, 0, 1}}}, Boxed -> False], 5]
Out[35]=

Possible Issues (1) 

In 3D, if the vertices are not in a plane, the polygon triangulation can be unpredictable:

In[36]:=
Graphics3D[{Opacity[0.6], RandomPolygon[3 -> "Simple", 20]}] // ResourceFunction[ "PerforatePolygons"]
Out[36]=

Neat Examples (3) 

Beethoven missing his ninth:

In[37]:=
ResourceFunction["PerforatePolygons"][ ExampleData[{"Geometry3D", "Beethoven"}]]
Out[37]=

A random winding polygon (this may take several minutes):

In[38]:=
WindingPolygon[RandomReal[1, {200, 2}]]
In[39]:=
Graphics[(Append[#1, VertexColors -> Table[RandomColor[], {Length[#1[[1]]]}]] &) /@ Flatten[Last /@ Most@(ResourceFunction["PerforatePolygons"][ WindingPolygon[RandomReal[1, {200, 2}]], .5])]]
Out[40]=

Decomposing random polygons and perforating twice:

In[41]:=
Map[Graphics[(Append[#1, VertexColors -> Table[RandomColor[], {Length[#1[[1]]]}]] &) /@ DeleteCases[ Flatten@ResourceFunction["PerforatePolygons"][ ResourceFunction["PerforatePolygons"][ Flatten[RandomPolygon[{#, 150}]], #], "Simple"], EdgeForm[], \[Infinity]]] &, {"Simple", "Convex", "ConvexHull", "StarShaped"}] // GraphicsRow
Out[41]=

Publisher

Enrique Zeleny

Version History

  • 2.0.0 – 02 November 2021
  • 1.1.0 – 04 February 2021
  • 1.0.0 – 01 October 2020

Related Resources

License Information