# Build a region from an unsorted set of points (Imported from a .DXF file)

DXF File - HEA

DXF File - UNP

DXF File - RRW

Context :

Every file contains a drawing of a particular type of steel profile used in civil engineering. I added three of them for generality purposes. They come directly from the supplier and consider that they cannot be modified. I would like to import their geometry as a Polygon to perform further calculations. Let's first import the three geometries in Mathematica :

HEA = Import["...\\HEA 200.dxf"]
UNP = Import["...\\UNP 200.dxf"]
RRW = Import["...\\RRW 100 100 5.dxf"]


All objects are MeshRegion objects as one can check with Head@HEA. From these objects, one can extract the points defining the MeshRegion and convert them to the 2D plane :

Coord = DeleteCases[Extract[MeshPrimitives[HEA, 0], {All, 1}][[All, {1, 2}]], {0., 0.}];
Pts = Map[Point, Coord];
Graphics@Pts


Same for the lines :

lines = Extract[MeshPrimitives[HEA, 1], {All, 1}][[All,All, {1, 2}]];
lines = Map[Line, lines];
Graphics@lines


Problem :

If you plot Coord with a joined ListPlot, you will see that the points are unsorted according to the the above Figure which is problematic for defining a Polygon or a Region.

ListPlot[Coord, Joined -> True]


I aim to sort the points for obtaining a proper Region. It should work for the three .dxf files. The RRW.dxf contains a hole, and I wonder if one can deal with this added difficulty...

For now I've tried to sort the points with FindShortestTour but unsuccessful.

Any idea ?

#############################

Update 17.06.2023

I have fixed the access link to the HEA and RRW profile.

After the replies from @cvgmt, @Daniel Huber and @kglr, who are all acknowledged, I'm going to accept @Daniel Huber's answer because it also makes it possible to deal with geometries that contain two closed sub-regions (such as the RRW profile). The other responses remain simpler and interesting for less general cases.

The code originally desired is reduced to the following form:

DXF2DConvert[Profile_] :=
Module[{lin, sel, check1, check2, found, res, Dim},
lin = MeshPrimitives[Profile, 1][[All, 1]];
res = Reap[
While[lin != {}, sel = {lin[[1]]}; lin = Rest[lin];
check1 = sel[[1, 1]];
check2 = sel[[1, -1]];
found = True;
While[found, found = False;
Do[t = lin[[i]];
Switch[lin[[i]], {__, check1}, PrependTo[sel, lin[[i]]];
check1 = sel[[1, 1]]; found = True;
lin[[i]] = Null;, {check2, __}, AppendTo[sel, lin[[i]]];
check2 = sel[[-1, -1]]; found = True;
lin[[i]] = Null;, {check1, __},
PrependTo[sel, Reverse@lin[[i]]];
check1 = sel[[1, 1]]; found = True;
lin[[i]] = Null;, {__, check2},
AppendTo[sel, Reverse@lin[[i]]];
check2 = sel[[-1, -1]]; found = True; lin[[i]] = Null;];, {i,
Length[lin]}];
lin = lin /. Null -> Sequence[];];
Sow[sel];]][[2, 1]];
res = Flatten[Append[#[[All, ;; -2]], #[[-1, 2 ;; -1]]], 1] & /@ res;
res = res[[All, All, {1, 2}]];
Dim = Dimensions@res;
If[Dim[[1]] == 1,
Polygon[res[[1]]],
Polygon[res[[1]] -> res[[2 ;;]]]
]
]

Map[Graphics@DXF2DConvert@# &, {HEA, UNP, RRW}]


Which returns :

• You should be able to download the RRW and HEA files now. Can you try ? Jun 18, 2023 at 8:20
• All of the three links broken. Jun 18, 2023 at 8:25
• I added a permanent link, it should work now Jun 18, 2023 at 8:38

I can only read the file UNP, the others need a login.

This files contains a lot of line segments, that belong to one single line, in a chaotic order. To get a list of these segments:

unp = Import["d:\\downloads\\UNP 200.dxf"];
d = MeshPrimitives[unp, 1][[All, 1]];
Graphics3D[Line /@ gatherAlign[d], Boxed -> False]


These lines are actually a single lines, but one needs to assemble the different pieces.

Here is a program that does this:

gatherAlign[lines_] :=
Module[{lin = lines, sel, check1, check2, found, res},
res = Reap[
While[lin != {},
sel = {lin[[1]]}; lin = Rest[lin]; check1 = sel[[1, 1]];
check2 = sel[[1, -1]];
found = True;
While[found, found = False;
Do[t = lin[[i]];
Switch[lin[[i]]
, {__, check1}, PrependTo[sel, lin[[i]]];
check1 = sel[[1, 1]]; found = True; lin[[i]] = Null;
, {check2, __}, AppendTo[sel, lin[[i]]];
check2 = sel[[-1, -1]]; found = True; lin[[i]] = Null;
, {check1, __}, PrependTo[sel, Reverse@lin[[i]]];
check1 = sel[[1, 1]];   found = True; lin[[i]] = Null;
, {__, check2}, AppendTo[sel,  Reverse@lin[[i]]];
check2 = sel[[-1, -1]]; found = True; lin[[i]] = Null;
];
, {i, Length[lin]}];
lin = lin /. Null -> Sequence[];
];
Sow[sel];
]
][[2, 1]];
Flatten[Append[#[[All, ;; -2]], #[[-1, 2 ;; -1]]], 1] & /@ res
]


With the help of this, we may create one single continuous line:

line=gatherAlign[d]


and we may plot this line:

Graphics3D[Line[line], Boxed -> False]


what gives agine the above picture.

## Edit-2

We can also does not depend on FindCycle since BoundaryMeshRegion will reorder the points to build the region.

reg = Import["RRW 100 100 5.dxf"];
pts0 = Most /@ MeshCoordinates[reg];
lines0 = MeshCells[reg, 1, "Multicells" -> True];
reg1 = BoundaryMeshRegion[pts0, lines0];
pts1 = MeshCoordinates[reg1];
lines1 = MeshCells[reg1, 1, "Multicells" -> True];
ListLinePlot[
pts1[[#]] & /@ Append[#, First@#] & /@
lines1[[;; , 1]][[;; , ;; , 1]], PlotRange -> All,
AspectRatio -> Automatic]
reg1


## Edit-1

Clear["Global*"];
rebuild[reg_] :=
Module[{pts0, indexs0, graph, cycles, indexs, pts},
pts0 = Most /@ MeshCoordinates[reg];
lines0 = MeshCells[reg, 1, "Multicells" -> True];
graph = lines0 /. Line -> MapApply@UndirectedEdge;
cycles = Level[FindCycle[#, Infinity, All] & /@ graph, {-3}];
indexs = cycles[[;; , ;; , 1]];
pts = pts0[[#]] & /@ indexs;
BoundaryMeshRegion[Catenate@pts,
Line@Append[#, First@#] & /@
TakeList[Range@Total[Length /@ indexs], Length /@ indexs]]]

rebuild /@ {Import["UNP 200.dxf"], Import["HEA 200.dxf"],
Import["RRW 100 100 5.dxf"]}


RegionUnion[Import["UNP 200.dxf"],
TransformedRegion[Import["RRW 100 100 5.dxf"],
TranslationTransform[{100, 80, 0}]],
TransformedRegion[Import["HEA 200.dxf"],
TranslationTransform[{200, 80, 0}]]] // rebuild


## Original

Here we using FindCycle to re-order the points.

UNP = Import["UNP 200.dxf"];
pts0 = MeshCoordinates[UNP];
indexs0 =
MeshCells[UNP, 1, "Multicells" -> True] /. Line -> Identity;
cycles = FindCycle /@ Apply[UndirectedEdge, indexs0, {2}];
indexs = Map[Append[#, First@#] &, Apply[First, cycles, {3}], {2}];
pts = MeshCoordinates[UNP][[#]] & @@@ indexs;

ListLinePlot3D[pts, BoxRatios -> Automatic, Boxed -> False,
AxesOrigin -> {0, 0, 0}, PlotRange -> All]
ListLinePlot[Map[Most, pts, {2}], AspectRatio -> Automatic,
PlotRange -> All]


Update: A combination of TransformedRegion + MeshPrimitives + BoundaryDiscretizeGraphics

bDG = BoundaryDiscretizeGraphics @
MeshPrimitives[#, 1] & @
TransformedRegion[#, Most] &;


Examples:

{unp200, hea200, rrw100} = Import[HomeDirectory[] <> "/Downloads/" <> #] & /@
{"UNP 200.dxf", "HEA 200.dxf", "RRW 100 100 5.dxf"};

Row[bDG /@ {unp200, hea200, rrw100}, Spacer[10]]


lines2D = MeshPrimitives[#, 1, Multicells -> True] & @* bDG ;

Row[Graphics[lines2D @ #, ImageSize -> #2] & @@@
Transpose[{{unp200, hea200, rrw100}, {110, 300, 300}}], Spacer[20]]


Row[ListLinePlot[lines2D[#] /. Line -> Apply[Join], Axes -> False] & /@
{unp200, hea200, rrw100}, Spacer[20]]


unp200 = Import[HomeDirectory[] <> "/Downloads/UNP 200.dxf",
"LineObjects"][[All, All, All, ;; -2]] /. Line -> Identity;

edgeList = Map[Splice @ Partition[#, 2, 1, {1, -1}, {}, UndirectedEdge] &] @
Rationalize[unp200, 10^-6];

sortedCoords = VertexList @ First @ FindHamiltonianCycle @ edgeList;

Graphics[{Red, EdgeForm[Gray], FaceForm[Opacity @ .25],
Polygon @ sortedCoords}]


• You can use DimensionalMeshComponents to extract the line segments as a mesh btw. Jun 21, 2023 at 12:27
• Thank you @GregHurst; good point. I did try ConnectedMeshComponents but not DimensionalMeshComponents.
– kglr
Jun 21, 2023 at 12:51
• In terms of code simplicity, this is quite impressive... Jun 21, 2023 at 18:27
R = Import["/.../HEA 200.dxf"];
pts = MeshCoordinates[R];
G = Graph[
Range[MeshCellCount[R, 0]],
MeshCells[R, 1, "Multicells" -> True][[1, 1]]
];
cycles = Map[
pts[[VertexList[#][[FindShortestTour[#][[2]]]]]] &,
ConnectedGraphComponents[G]
];

ListLinePlot3D[cycles]
`