Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/24.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel AutoCad VBA查找X&;Y现有楼宇的位置_Excel_Vba_Autocad - Fatal编程技术网

Excel AutoCad VBA查找X&;Y现有楼宇的位置

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

我正在尝试查找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 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