Excel AutoCad VBA查找X&;Y现有楼宇的位置
我正在尝试查找AutoCad文档中特定图层上已存在的块的x和y位置。当前代码仅返回X位置和ent.InsertionPoint(0)和ent.InsertionPoint(1)不返回任何内容。任何帮助都会很好Excel AutoCad VBA查找X&;Y现有楼宇的位置,excel,vba,autocad,Excel,Vba,Autocad,我正在尝试查找AutoCad文档中特定图层上已存在的块的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
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
我能用这个让它工作。您需要将插入点设置为变量,以便可以访问x/y/z阵列。不确定X位置是什么意思,因为插入点阵列中就是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中的VBA