How to get position vertex of a polygon?

m09366023695 · ‎01-28-2023

I how polygons and I want to get positions of vertexes(red cycles) to calculate length of each side (blue lines).

grobnik · ‎01-29-2023

Hi @m09366023695 you can try with

Sub Example_Coordinates()

Dim Selection As AcadSelectionSet
Dim Poly As AcadLWPolyline
Dim Obj As AcadEntity
Dim Bound As Double

'Makes a selectionset.
On Error Resume Next
   Set Selection = ThisDrawing.SelectionSets.Item("Select polyline.")
If Err Then
   Set Selection = ThisDrawing.SelectionSets.Add("Select polyline.")
   Err.Clear
Else
   Selection.Clear
End If

'Select the polyline.
Selection.SelectOnScreen

For Each Obj In Selection

   If Obj.ObjectName = "AcDbPolyline" Then
       
           Set Poly = Obj
           On Error Resume Next
           
           Bound = UBound(Poly.Coordinates)
           
           x = 0
           y = 1
           
           For i = 0 To Bound / 2
               
               Debug.Print "X= " & Poly.Coordinates(x) & "  Y= " & Poly.Coordinates(y)
               If Err Then Err.Clear
               
               x = x + 2
               y = y + 2
               
           Next
         
   End If

Next Obj

End Sub

On immediate window you will found each vertex coordinates X, Y of course not Z.

grobnik · ‎01-29-2023

Hi @m09366023695 here below a tentative to reach segment length. Probably there will be a best way but simply I'm drawing a line from each vertex to the next retrieving the line length and in the same time polygon segment length.

Sub Example_Coordinates()

Dim Selection As AcadSelectionSet
Dim Poly As AcadLWPolyline
Dim Obj As AcadEntity
Dim Bound As Double
Dim MyStartCoords(0 To 2) As Double
Dim MyEndCoords(0 To 2) As Double
Dim MyLine As AcadLine
Dim x As Integer
Dim y As Integer
'Makes a selectionset.
On Error Resume Next
  ' Set Selection = This785Drawing.SelectionSets.Item("Select polyline.")
'If Err Then
   'Set Selection = ThisDrawing.SelectionSets.Add("Select polyline.")
  ' Err.Clear
'Else
 '  Selection.Clear
'End If

'Select the polyline.
'Selection.SelectOnScreen
For Each Obj In ThisDrawing.ModelSpace

'For Each Obj In Selection

   If Obj.ObjectName = "AcDbPolyline" Then
       
           Set Poly = Obj
           On Error Resume Next
           
           Bound = UBound(Poly.Coordinates)
           
           x = 0
           y = 1
           
           For I = 0 To Bound / 2
                    MyStartCoords(0) = Poly.Coordinates(x)
                    MyStartCoords(1) = Poly.Coordinates(y)
                    MyStartCoords(2) = 0

                    MyEndCoords(0) = Poly.Coordinates(x + 2)
                    MyEndCoords(1) = Poly.Coordinates(y + 2)
                    MyEndCoords(2) = 0
               
               Set MyLine = ThisDrawing.ModelSpace.AddLine(MyStartCoords, MyEndCoords)
               MyLenght = MyLine.Length
               'Debug.Print "Vertex #  " & I + 1 & "  X= " & Poly.Coordinates(x) & "  Y= " & Poly.Coordinates(y) & " Lenght " & MyLenght
               If Err Then Err.Clear
               
               x = x + 2
               y = y + 2
               MyLine.Delete
           Next
                    MyStartCoords(0) = Poly.Coordinates(Bound - 1)
                    MyStartCoords(1) = Poly.Coordinates(Bound)
                    MyStartCoords(2) = 0
                    
                    MyEndCoords(0) = Poly.Coordinates(0)
                    MyEndCoords(1) = Poly.Coordinates(1)
                    MyEndCoords(2) = 0
                    Set MyLine = Null
                    Set MyLine = ThisDrawing.ModelSpace.AddLine(MyStartCoords, MyEndCoords)
                    MyLenght = MyLine.Length
                    Debug.Print " Lenght " & MyLenght
                    MyLine.Delete
   End If

Next Obj

End Sub