Hi Bill,
Here's ya a little something that should help.
Joe
--
Option Explicit
'Autodesk example of creating a polyline
Sub Example_AddPolyline()
' This example creates a polyline in model space.
Dim plineObj As AcadPolyline
Dim Points(0 To 14) As Double
' Define the 2D polyline points
Points(0) = 1: Points(1) = 1: Points(2) = 0
Points(3) = 1: Points(4) = 2: Points(5) = 0
Points(6) = 2: Points(7) = 2: Points(8) = 0
Points(9) = 3: Points(10) = 2: Points(11) = 0
Points(12) = 4: Points(13) = 4: Points(14) = 0
' Create a light weight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(Points)
ZoomAll
End Sub
'Autodesk example of creating a LWPolyline
Sub Example_AddLightWeightPolyline()
' This example creates a light weight polyline in model space.
Dim plineObj As AcadLWPolyline
Dim Points(0 To 9) As Double
' Define the 2D polyline points
Points(0) = 1 + 2: Points(1) = 1 + 2
Points(2) = 1 + 2: Points(3) = 2 + 2
Points(4) = 2 + 2: Points(5) = 2 + 2
Points(6) = 3 + 2: Points(7) = 2 + 2
Points(8) = 4 + 2: Points(9) = 4 + 2
' Create a light weight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
ZoomAll
End Sub
'Joe Sutphin routine to change a polyline to a LWPolyline
Public Sub ConvertPolylineToLWPolyline()
Dim oEntity As AcadEntity
Dim Point As Variant
Dim oLWPolyline As AcadLWPolyline
Dim oSS As AcadSelectionSet
Dim iFilterCode(0) As Integer
Dim vFilterValue(0) As Variant
Dim oPolyline As AcadPolyline
'handle errors inline with code
On Error Resume Next
'delete any selection sets hanging around
Application.ActiveDocument.SelectionSets("Polys").Delete
'reset error handling
On Error GoTo 0
'create our new selection set
Set oSS = Application.ActiveDocument.SelectionSets.Add("Polys")
'construct a selection set filter for polylines only
iFilterCode(0) = 0: vFilterValue(0) = "Polyline"
'get user to select a PViewport
oSS.SelectOnScreen iFilterCode, vFilterValue
'construct new LWPolylines for each polyline in the selection set
If oSS.Count Then
For Each oPolyline In oSS
Dim Points() As Double
Dim i As Long
Dim j As Long
ReDim Points((((UBound(oPolyline.Coordinates) + 1) / 3) * 2) - 1)
For i = 0 To UBound(oPolyline.Coordinates)
Points(j) = oPolyline.Coordinates(i): i = i + 1: j = j + 1
Points(j) = oPolyline.Coordinates(i): i = i + 1: j = j + 1
Next i
Set oLWPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
j = 0
'iterate through setting the bulge factor
For i = 0 To ((UBound(oPolyline.Coordinates) + 1) / 3) - 1
oLWPolyline.SetBulge j, oPolyline.GetBulge(i)
j = j + 1
Next i
'delete the old polyline
oPolyline.Delete
Next oPolyline
End If
End Sub
'change the polyline to have a bulge
Public Sub SetBulgeOfPolyline()
Dim oEntity As AcadPolyline
Dim Point As Variant
'there is no error checking in this routine, it's for test purposes
ThisDrawing.Utility.GetEntity oEntity, Point
'change the bulge factor
oEntity.SetBulge 2, 0.5
End Sub
