How to convert Lines object in Polyline VBA CODE

[Anonymous]

I want to ask if somebody knows or have a code for converting Lines in to Polyline with a visual basic application code. Thanks

I have Collection of lines in a ColLines as variant

For j=0 to Ubound(ColLines)
ColLines.startpoint
ColLines.endpoint
Next

The lines don't have a secuence of drawing. For example
Line1: StartPoint: 0,0 : End Point: 1,0
Line2: StartPoint: 1,1 : End Point: 0,1
Line3: StartPoint: 1,0 : End Point: 1,1
Line4: StartPoint: 0,1 : End Point: 0,0

I need create the vector list(PolylinePoints) for insert in my code:
Dim PolylinePoint ( ) as Double
Application.Documents.Item(pFiberDrawingName).ModelSpace.AddLightWeightPolyline (PolylinePoints)

The secuence correct is
Line1, Line3, Line2 and Line4

[Anonymous]

Hi
Please try this and this may help u

Sub Convert_Lines_To_Polylines()
Dim myLine As AcadLine
Dim myPline As AcadLWPolyline
Dim Points(0 To 3) As Double
Dim sset As AcadSelectionSet
Dim fType(0 To 2) As Integer
Dim fData(0 To 2) As Variant
Dim Stpoint As Variant
Dim Enpoint As Variant
Dim i As Integer
Dim j As Integer
Dim Mylayer As AcadLayer
i = 0
j = 0
Set sset = ThisDrawing.SelectionSets.Add("ss0")
fType(0) = 0
fData(0) = "LINE"
fType(1) = 67
fData(1) = 0
fType(2) = 8
fData(2) = "*"
sset.Select acSelectionSetAll, , , fType, fData
For Each myLine In sset
i = i + 1
Stpoint = myLine.startPoint
Enpoint = myLine.endPoint
Points(0) = Stpoint(0): Points(1) = Stpoint(1)
Points(2) = Enpoint(0): Points(3) = Enpoint(1)
Set myPline = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
myPline.Layer = myLine.Layer
myPline.Linetype = myLine.Linetype
myPline.Lineweight = myLine.Lineweight
myPline.LinetypeScale = myLine.LinetypeScale
myLine.Delete
Next myLine
sset.Delete
ThisDrawing.Application.Update
Set sset = ThisDrawing.SelectionSets.Add("ss1")
fType(0) = 0
fData(0) = "LINE"
fType(1) = 67
fData(1) = 1
fType(2) = 8
fData(2) = "*"
sset.Select acSelectionSetAll, , , fType, fData
For Each myLine In sset
j = j + 1
Stpoint = myLine.startPoint
Enpoint = myLine.endPoint
Points(0) = Stpoint(0): Points(1) = Stpoint(1)
Points(2) = Enpoint(0): Points(3) = Enpoint(1)
Set myPline = ThisDrawing.PaperSpace.AddLightWeightPolyline(Points)
myPline.Layer = myLine.Layer
myPline.Layer = myLine.Layer
myPline.Linetype = myLine.Linetype
myPline.Lineweight = myLine.Lineweight
myPline.LinetypeScale = myLine.LinetypeScale
myLine.Delete
Next myLine
sset.Delete
If i 0 Or j 0 Then
MsgBox i & " Lines in modelspace and" & vbCr & _
j & " Lines im paperspace" & vbCr & _
"converted to polylines"
Else: If i = 0 And j = 0 Then MsgBox "All lines already converted"
End If
End Sub

[Anonymous]

The Code is usefull only for convert one line in to polylines but this is easy, the problem is convert several lines that they are not consecutives and the end point of one line not is the start point of the other line.

[Anonymous]

I could do the code for convert some lines in to single polyline here is the section of the code


Public Sub Convert_Lines_Into_Polyline ( )

Dim objLine As AcadObject
Dim Items As AcadObject
Dim i as Integer, x As Integer
Dim PolylinePoints( ) As Double
Dim Stpoint As Variant
Dim Enpoint As Variant

x=0
For Each objLine In ThisDrawing.Blocks
For Each Items In objLine
If Items.EntityName = "AcDbLine" Then
x = x + 1
End If
Next
Next
ReDim PolylinePoints(0 To (((4 * x) / 2) - 1))
x = 3
i = 1
Do While i > 0
For Each objLine In ThisDrawing.Blocks
For Each Items In objLine
If Items.EntityName = "AcDbLine" Then
Stpoint = Items.startPoint
Enpoint = Items.endPoint
If x = 3 Then
PolylinePoints(0) = Stpoint(0): PolylinePoints(1) = Stpoint(1)
PolylinePoints(2) = Enpoint(0): PolylinePoints(3) = Enpoint(1)
Items.Delete
x = x + 1
Else
If Round(PolylinePoints(x - 2), 5) = Round(Stpoint(0), 4) And Round(PolylinePoints(x - 1), 5) = Round(Stpoint(1), 4) Then
PolylinePoints(x) = Enpoint(0): PolylinePoints(x + 1) = Enpoint(1)
Items.Delete
x = x + 2
ElseIf Round(PolylinePoints(x - 2), 5) = Round(Enpoint(0), 5) And Round(PolylinePoints(x - 1), 5) = Round(Enpoint(1), 5) Then
PolylinePoints(x) = Stpoint(0): PolylinePoints(x + 1) = Stpoint(1)
Items.Delete
x = x + 2
End If
If x > UBound(PolylinePoints) Then
GoTo Fuera
End If
End If
End If
Next Items
Next objLine
i = 0
For Each objLine In ThisDrawing.Blocks
i = i + 1
Next objLine
Loop
Fuera:

End Sub Edited by: Zeusovsky on Dec 26, 2008 10:29 PM