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

Question

Please consider trying to download the following .dxf files :

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 :

Answer 1

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.

Answer 2

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]

Answer 3

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]]

Original answer:

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}]

Answer 4

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]