# Creating a MeshRegion object from a Graphics object

I am looking to convert a simple Graphics object that is defined by overlapping polygons into a MeshRegion object.

For example, here is code that will create three overlapping triangles

Table[Polygon@Map[{Cos[#], Sin[#]} &,
{RandomReal[{0, 2 Pi/3}],
RandomReal[{2 Pi/3, 4 Pi/3}],
RandomReal[{4 Pi/3, 2 Pi}]}], 3]
Graphics[{EdgeForm[Black], White, %}]


For the instance

{Polygon[{{-0.334165, 0.942514}, {-0.67166, 0.740859}, {-0.455064, -0.890459}}],
Polygon[{{0.274586, 0.961563}, {-0.99882, -0.0485668}, {-0.454045, -0.890979}}],
Polygon[{{0.832368, 0.554224}, {-0.977216, -0.212246}, {0.451922, -0.892057}}]}


we get the picture

I would like to convert this to a simple 1D MeshRegion Object with vertices at each intersection of two edges and line segments between them, but I am at a loss for how to do it efficiently.

For a small figure with three triangles, it is possible to do manually by finding the intersection points and the incidences, but when a Graphics object has dozens of polygons with many sides (possibly approximating circles), an automated function would be desirable!

One thing that I have tried and it has worked in a minimal yet extremely complicated manner was to convert each polygon to a 2D BoundaryMeshRegion object and use RegionDifference commands. I've tried other things like ImageMesh which has only given me more mess, but I feel there must be a simpler way, or at least a reason why there is no simple way.

After defining the variable triangles to be this set of three triangles, I turned each of the triangles into a BoundaryMeshRegion.

Table[triregion[i] = BoundaryDiscretizeGraphics[Graphics[triangles[[i]]]],
{i, 1, Length[triangles]}]


I then defined the order of the layers: The third triangle is above the second triangle is above the first triangle:

layerorder = {3, 2, 1}


Then I calculated which of the layers intersect which of the other layers. Here we see that layer 3 intersects layer 2, layer 3 intersects layer 1, and layer 2 intersects layer 1.

intersections = Flatten[
Table[If[Length[
RegionIntersection[
triregion[layerorder[[i]]],
triregion[layerorder[[j]]]]
] == 0, {layerorder[[i]], layerorder[[j]]}, Nothing],
{i, 1, 3}, {j, i + 1, 3}], 1]

Out: {{3, 2}, {3, 1}, {2, 1}}


Now define new MeshRegions that are the original MeshRegion subtracting out each intersecting MeshRegion using RegionDifference

Table[newregion[i] = triregion[i], {i, 20}];
Map[(newregion[#[[2]]] = RegionDifference[newregion[#[[2]]], triregion[#[[1]]]]) &,
intersections];


Here is the result.

To get the 1D frame I use MeshPrimitives

boundaries = Map[MeshPrimitives[#, 1] &, {newregion[1], newregion[2], newregion[3]}];
Show[Graphics /@ boundaries]


But now certain line segments are traversed by two different edges with different vertices, which is not what I need. I'm just hoping to have the 1D wireframe defined as a MeshRegion Object.

• It might help if you can give an example of your code using RegionDifference? – Dunlop Jun 9 '17 at 4:22
• Thanks @Dunlop, I have tried to add additional information. – Christopher Hanusa Jun 9 '17 at 20:54

I think you can use RegionDifference by working with both the 1D and 2D representations of your polygons. Here is your example data:

d1 = {{-0.334165,0.942514},{-0.67166,0.740859},{-0.455064,-0.890459}};
d2 = {{0.274586,0.961563},{-0.99882,-0.0485668},{-0.454045,-0.890979}};
d3 = {{0.832368,0.554224},{-0.977216,-0.212246},{0.451922,-0.892057}};


Here are the 1D representations:

t1 = Line[Append[d1, First@d1]];
t2 = Line[Append[d2, First@d2]];
t3 = Line[Append[d3, First@d3]];


Here are the 2D representations:

p1 = Polygon[d1];
p2 = Polygon[d2];
p3 = Polygon[d3];


Now, the top triangle is t3:

r1 = t3;


The next triangle is t2, but we only want the part of t2 that is disjoint from p3:

r2 = RegionDifference[t2, p3];


Finally, the last triangle is t1, and we only want the part of t1 that is disjoint from p2 and p3:

r3 = RegionDifference[t1, RegionUnion[p2, p3]];


Finally, we want to create a mesh that is the union of r1, r2 and r3:

DiscretizeRegion @ RegionUnion[r1, r2, r3]


Update

In Mathematica 12, RegionUnion[r1, r2, r3] directly produces the desired output:

RegionUnion[r1, r2, r3]


• This is very much along the lines of what I wanted. I have been working to modify your code in order to simplify the polygons so that the number of vertices is minimal, but so far I have not succeeded. It looks like one thing that makes a big difference is using BoundaryDiscretizeGraphics instead of BoundaryDiscretizeRegion. – Christopher Hanusa Jun 13 '17 at 11:35
Region@RegionUnion[
Polygon[{{-0.334165, 0.942514}, {-0.67166, 0.740859}, {-0.455064, -0.890459}}],
Polygon[{{0.274586, 0.961563}, {-0.99882, -0.0485668}, {-0.454045, 0.890979}}],
Polygon[{{0.832368, 0.554224}, {-0.977216, -0.212246}, {0.451922, -0.892057}}]
]


• I am looking for a 1D MeshRegion Object instead of a 2D MeshRegion Object. See my edit. – Christopher Hanusa Jun 9 '17 at 20:53

Try the following code:

In[1]:= pols=Table[Polygon@Map[{Cos[#], Sin[#]} &, {RandomReal[{0, 2 Pi/3}],
RandomReal[{2 Pi/3, 4 Pi/3}], RandomReal[{4 Pi/3, 2 Pi}]}], 3];
In[2]:= Graphics[{EdgeForm[Black], White, pols}];
In[3]:= DiscretizeGraphics@%;
In[4]:= Graphics@MeshPrimitives[%, 1];
In[5]:= reg=DiscretizeGraphics@%


Is the last output what you are looking for? You can check the region dimension:

In[6]:= RegionDimension@reg
Out[16]= 1