Message 1 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
How do I shift the vertex position of a perimeter drawn with polylines in vba.

Solved! Go to Solution.
How do I shift the vertex position of a perimeter drawn with polylines in vba.

Solved! Go to Solution.
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.
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.
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
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
Obrigado, está me ajudando muito.
Já tenho base agora pra terminar o projeto.
thank you so much
What if I want to choose the vertex?