Just thought I would share this. I amde some changes and do not remember where the original code came from.
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
