将闭合 LWPolyline 转换为 2D 折线

Private Function polyentconvert2(polyEnt As Object) As AcadPolyline
Dim entity As AcadDocument
Set entity = AutoCAD_Application.ActiveDocument
Dim I As Integer, j As Integer, K As Integer
Dim EN2 As AcadPolyline
Dim b As Double, w As Double, W2 As Double
Dim PolyZPosition As Double
Dim polyentx As AcadPolyline
Dim FromNewPoint(0 To 2) As Double
Dim MoveNewPoint(0 To 2) As Double
 
 
 If polyEnt.EntityName = "AcDbPolyline" Then
  Dim Coords As Variant
  Coords = polyEnt.Coordinates
  I = Fix((UBound(Coords) + 1) * 1.5) - 1
  
  If I = 5 Then
  
  GoTo newconvert
  
  End If
  ReDim Coords2(I) As Double
  j = 0
  Dim X As Double, y As Double, z As Double
  
  For I = LBound(Coords) To UBound(Coords) Step 2
    X = Coords(I): y = Coords(I + 1): z = 0#
    Coords2(j) = X:
    Coords2(j + 1) = y:
    Coords2(j + 2) = z:
    j = j + 3
  Next I
  Dim Coords2V As Variant
  Coords2V = Coords2
  Set EN2 = entity.ModelSpace.AddPolyline(Coords2V)
  EN2.Closed = polyEnt.Closed
  EN2.Color = polyEnt.Color
  EN2.Linetype = polyEnt.Linetype
  EN2.Thickness = polyEnt.Thickness
    EN2.Layer = polyEnt.Layer
    
  
  For I = 0 To UBound(Coords) Step 2
    j = I / 2
    b = polyEnt.GetBulge(j)
    polyEnt.GetWidth j, w, W2
    EN2.SetBulge j, b
    EN2.SetWidth j, w, W2
  Next I
  
  
  Set polyentx = EN2
  
  polyEnt.GetBoundingBox minExt, maxExt
  PolyZPosition = Round(maxExt(2), 5)
                
                
  polyEnt.Delete
  
    FromNewPoint(0) = 0
    FromNewPoint(1) = 0
    FromNewPoint(2) = 0
    MoveNewPoint(0) = 0
    MoveNewPoint(1) = 0
    MoveNewPoint(2) = PolyZPosition
    EN2.Move FromNewPoint, MoveNewPoint
 End If
 GoTo endhere
 
 
 
newconvert:
 
 
I = I + 3
ReDim Coords2(I) As Double
 
Dim newcords As Variant
On Error Resume Next
Coords2(0) = Coords(0)
Coords2(1) = Coords(1)
Coords2(2) = 0
Coords2(3) = Coords(2)
Coords2(4) = Coords(3)
Coords2(5) = 0
Coords2(6) = Coords(0)
Coords2(7) = Coords(1)
Coords2(8) = 0
newcords = Coords2
 
 
    Set EN2 = entity.ModelSpace.AddPolyline(newcords)
    EN2.Closed = polyEnt.Closed
    EN2.Color = polyEnt.Color
    EN2.Linetype = polyEnt.Linetype
    EN2.Thickness = polyEnt.Thickness
    EN2.Layer = polyEnt.Layer
 
  For I = 0 To UBound(Coords) Step 2
    j = I / 2
    b = polyEnt.GetBulge(j)
    EN2.SetBulge j, b
  Next I
 
  polyEnt.GetBoundingBox minExt, maxExt
  PolyZPosition = Round(maxExt(2), 5)
                
                
  polyEnt.Delete
  
    FromNewPoint(0) = 0
    FromNewPoint(1) = 0
    FromNewPoint(2) = 0
    MoveNewPoint(0) = 0
    MoveNewPoint(1) = 0
    MoveNewPoint(2) = PolyZPosition
    EN2.Move FromNewPoint, MoveNewPoint
 
 
 
 
 
 
endhere:
End Function