excel - AutoCad VBA 查找现有 block 的 X 和 Y 位置

Question

我正在尝试查找 AutoCad 文档中特定图层上已有 block 的 x 和 y 位置。目前，代码仅返回 X 位置，ent.InsertionPoint(0) 和 ent.InsertionPoint (1) 不返回任何内容。任何帮助都会很棒!

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

Answer 1

我能够使用它来让它工作。您需要将插入点设置为变体变量，以便可以访问 x/y/z 数组。不确定 X 位置是什么意思，因为这就是插入点数组中的内容。

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

注意:我在 Autocad 中使用 VBA，而不是在 Excel 中。