AutoCad VBA finding the X &Y locations of existing blocks

Question

I am trying to find the x and y locations of blocks already in the AutoCad document on a specific layer. Currently the code is just returning the X-position and ent.InsertionPoint(0) and ent.InsertionPoint (1) returns nothing. Any help would be great!

Dim blk As AcadBlockReference
Dim atts As Variant
Dim att As AcadAttributeReference
Dim sset As AcadSelectionSet
Dim ent As AcadEntity
Dim obj As AcadObject

'Select all that are on the dup layer
On Error Resume Next
ACAD.ActiveDocument.SelectionSets.Item("Park-Dup").Delete
Set sset = ACAD.ActiveDocument.SelectionSets.Add("Park-Dup")
sset.Select acSelectionSetAll


Dim tryBlockRef As AcadBlockReference

For Each ent In sset
    If TypeOf ent Is AcadBlockReference Then
        Sheet1.Cells(i, 4) = ent.InsertionPoint
    End If
Next

braX · Accepted Answer · 2017-11-27T18:37:54.333

I was able to get it to work using this. You need to set the insertion point to a variant variable so you can access the x/y/z array. Not sure what you mean by X-position since that's what is in the insertion point array.

Public Sub test()
  Dim sset As AcadSelectionSet
  Dim ent As AcadEntity
  Dim Book1 As Object
  Dim Sheet1 As Object
  Dim xlApp As Object
  Set xlApp = CreateObject("Excel.Application")
  xlApp.Visible = True
  Set Book1 = xlApp.Workbooks.Add()
  Set Sheet1 = Book1.worksheets(1)
  Dim i As Integer

  'Select all that are on the dup layer
  On Error Resume Next
  ThisDrawing.SelectionSets.Item("Park-Dup").Delete
  On Error GoTo 0
  Set sset = ThisDrawing.SelectionSets.Add("Park-Dup")
  sset.Select acSelectionSetAll

  Dim inPt As Variant

  i = 1
  For Each ent In sset
      If TypeOf ent Is AcadBlockReference Then
        If InStr(ent.EffectiveName, "$") = 0 Then
            inPt = ent.InsertionPoint
            Sheet1.Cells(i, 1) = inPt(0)
            Sheet1.Cells(i, 2) = inPt(1)
            i = i + 1
        End If
      End If
  Next
End Sub

Note: I am using the VBA in Autocad, not in Excel.

AutoCad VBA finding the X &Y locations of existing blocks

1 Answers1