Polilynes

Polilynes

joaogoncalosantos
Enthusiast Enthusiast
1,108 Views
7 Replies
Message 1 of 8

Polilynes

joaogoncalosantos
Enthusiast
Enthusiast
How do I shift the vertex position of a perimeter drawn with polylines in vba.

PERGUNTA.PNG
0 Likes
Accepted solutions (2)
1,109 Views
7 Replies
Replies (7)
Message 2 of 8

norman.yuan
Mentor
Mentor

You really should describe your question better/in more details: what do you mean by "shift vertex position" and by "Current Vertex". In your case, there are 6 vertices in specific order that forms a Polyline (LwPolyline, I assume). Do you mean to swap 2 vertices' order while the vertices' coordinate (x and y) values remain un changed (so you get a polyline in different shape)?

 

Anyway, AcadLwPolyline has a property "Coordinate" and "Coordinates", which represent the coordinate of a given vertex (by its index) and all vertices. You can manipulate the coordinate values in Coordinate/Coordinates properties to achieve what you want, I suppose.

 

Norman Yuan

Drive CAD With Code

EESignature

Message 3 of 8

joaogoncalosantos
Enthusiast
Enthusiast

I want to change the position of the index, I don't want to change the value of the coordinates, example: when I select the polyline, and go to properties, there I see the vertex number, so I want to be able to choose where that vertex is located elsewhere.

0 Likes
Message 4 of 8

norman.yuan
Mentor
Mentor

As I said, the Coordinate/Coordinates properties, you can easily manipulate polyline's vertices, either change the actual coordinate value, or change the vertex' order (index). Following code swap 2 vertices by its index:

 

Option Explicit

Public Sub Test()
    Dim ent As AcadEntity
    Dim pt As Variant
    Dim poly As AcadLWPolyline
    
    On Error Resume Next
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select a polyline:"
    If ent Is Nothing Then Exit Sub
    If TypeOf ent Is AcadLWPolyline Then
        Set poly = ent
        '' swap the second vertex and the third vertex
        SwapVertices poly, 1, 2
    End If
    
End Sub

Private Sub SwapVertices(poly As AcadLWPolyline, index1 As Integer, index2 As Integer)

    Dim count As Integer
    count = (UBound(poly.Coordinates) + 1) / 2
    
    If index1 > count - 1 Or index2 > count - 1 Then
        MsgBox "Invalid vertex index!"
        Exit Sub
    End If
    
    Dim pt1 As Variant
    Dim pt2 As Variant
    
    pt1 = poly.Coordinate(index1)
    pt2 = poly.Coordinate(index2)
    
    poly.Coordinate(index1) = pt2
    poly.Coordinate(index2) = pt1

End Sub

HTH

 

Norman Yuan

Drive CAD With Code

EESignature

Message 5 of 8

joaogoncalosantos
Enthusiast
Enthusiast

PERGUNTA1.PNG

0 Likes
Message 6 of 8

norman.yuan
Mentor
Mentor
Accepted solution

If you had just spent a bit time to understand AcadLwPolyline's Coordinate/Coordinates property, you would have easily figured out how to do what you want: you simply grab each vertex point by Coordinate(index), where index started from 0, and reasign the obtained points to Coordinate(index) from the second point, which shift each vertex forward by one. Following code shows how to do it (you can shift by 1, or 2, or...):

 

Option Explicit

Public Sub Test()

    Dim ent As AcadEntity
    Dim pt As Variant
    Dim poly As AcadLWPolyline
    On Error Resume Next
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select a polyline:"
    If ent Is Nothing Then Exit Sub
    If TypeOf ent Is AcadLWPolyline Then
        Set poly = ent
        ShiftVertices poly, 2
    End If
    
End Sub

Private Sub ShiftVertices(poly As AcadLWPolyline, moveIndex0To As Integer)
    
    Dim count As Integer
    Dim i As Integer
    Dim points() As Variant
    count = (UBound(poly.Coordinates) + 1) / 2
    ReDim points(0 To count - 1)
    
    For i = 0 To count - 1
        points(i) = poly.Coordinate(i)
    Next
    
    Dim j As Integer
    j = moveIndex0To
    For i = 0 To count - 1
        If (j > count - 1) Then j = 0
        poly.Coordinate(i) = points(j)
        j = j + 1
    Next
    poly.Update
    
End Sub

 

HTH

 

Norman Yuan

Drive CAD With Code

EESignature

Message 7 of 8

joaogoncalosantos
Enthusiast
Enthusiast
Accepted solution

Obrigado, está me ajudando muito.

 

Já tenho base agora pra terminar o projeto.

 

thank you so much

0 Likes
Message 8 of 8

joaogoncalosantos
Enthusiast
Enthusiast
What if I want to choose the vertex?
0 Likes