I am trying to iterate through multiple polylines in autocad. My goal is to extract the coordinates of each vertex for each polyline into excel. could someone help me out please. I do not know how to fix this, the last portion of the code in which I itertate through the polylines is troublesome.
Here is the code:
Public Sub ImportHCS()
'************************************
'VARIABLE DECLARATION
'Declaring AutoCAD variables
Dim acadApp As AcadApplication
Dim acadDoc As AcadDocument
'Name of Layer to be Imported
Dim LayerName As String
'HCS Selection Set
Dim HCS As AcadSelectionSet
'HCS Polyline Entities
Dim HCSEnt As Object
Dim HCSEnts() As Object
Dim intVCnt() As Integer
Dim varCords As Variant
Dim varVert As Variant
Dim varCord As Variant
Dim varNext As Variant
Dim intCrdCnt As Integer
Dim j As Integer
'Codes for layer filtering
Dim intCodes(0) As Integer
Dim varCodeValues(0) As Variant
'************************************
'************************************
'Activate Sheet1
Sheet1.Activate
'************************************
'************************************
'Check if AutoCAD is open, if a drawing file is open
'Check if AutoCAD is open.
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
On Error GoTo 0
'If AutoCAD is not opened create a new instance and make it visible.
If acadApp Is Nothing Then
Set acadApp = New AcadApplication
acadApp.Visible = True
End If
'Check if there is an active drawing.
On Error Resume Next
Set acadDoc = acadApp.ActiveDocument
On Error GoTo 0
'No active drawing found. Create a new one.
If acadDoc Is Nothing Then
Set acadDoc = acadApp.Documents.Add
acadApp.Visible = True
End If
'************************************
'************************************
'Selecting the layer
On Error GoTo Done
'Create a new selectionset
Set HCS = acadDoc.SelectionSets.Add("HCS")
'Set the code for layer
intCodes(0) = 8
'Set the value specified by user
LayerName = Cells(3, 3).Value
varCodeValues(0) = LayerName
'Filter the objects
HCS.Select acSelectionSetAll, , , intCodes, varCodeValues
'Highlight the selected entities
HCS.Highlight True
Sheet2.Activate
'Pause for the user
MsgBox (HCS.Count & " entities selected")
'************************************
'************************************
'Iterating through each polyline and extracting vertex count, vertex x, vertex y
ReDim intVCnt(0 To HCS.Count - 1)
ReDim varCords(0 To HCS.Count - 1)
'Populate All HCS Entities in an Array
j = 0
For Each HCSEnt In HCS
ReDim Preserve HCSEnts(0 To j)
Set HCSEnts(j) = HCSEnt
j = j + 1
Next HCSEnt
'Find the number of vertices of each HCS Entity
For j = 0 To HCS.Count - 1
intVCnt(j) = 0
varCords(j) = HCSEnts(j).Coordinates
For Each varVert In varCords(j)
intVCnt(j) = intVCnt(j) + 1
Next varVert
MsgBox ("No. of vertices of PL" & j & "is " & intVCnt(j) * 0.5)
Next j
'j = 0
'Get the coordinates of each vertex of each HCS Entity
For j = 0 To (HCS.Count - 1)
MsgBox ("J is equal to" & j)
For intCrdCnt = 0 To intVCnt(j) - 1
varCord = HCSEnts(j).Coordinate(intCrdCnt)
Cells(j * intVCnt(j) + intCrdCnt + 1, 1).Value = varCord(0)
Cells(j * intVCnt(j) + intCrdCnt + 1, 2).Value = varCord(1)
'if intCrdCnt=intVCnt(j)-1
MsgBox ("V" & intCrdCnt)
MsgBox ("Coord" & intCrdCnt)
Next intCrdCnt
Next j
'************************************
'Unhighlight the entities
HCS.Highlight False
'Error Handler
Done:
'If the selection was created, delete it
If Not HCS Is Nothing Then
HCS.Delete
End If
'************************************
End Sub
