3
$\begingroup$

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

enter image description here

Same for the lines :

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

enter image description here

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]

enter image description here

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 :

enter image description here

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

4 Answers 4

3
$\begingroup$

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]

enter image description here

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.

$\endgroup$
6
$\begingroup$

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

enter image description here

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

enter image description here enter image description here

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

enter image description here

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]

enter image description here

$\endgroup$
2
$\begingroup$

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

enter image description here

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

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

enter image description here

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

enter image description here

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

enter image description here

$\endgroup$
3
  • $\begingroup$ You can use DimensionalMeshComponents to extract the line segments as a mesh btw. $\endgroup$
    – Greg Hurst
    Jun 21, 2023 at 12:27
  • $\begingroup$ Thank you @GregHurst; good point. I did try ConnectedMeshComponents but not DimensionalMeshComponents. $\endgroup$
    – kglr
    Jun 21, 2023 at 12:51
  • $\begingroup$ In terms of code simplicity, this is quite impressive... $\endgroup$ Jun 21, 2023 at 18:27
0
$\begingroup$
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]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.