从EXCEL获取边界框
你好我试图得到一个层上所有实体的边界框。
我希望能够从EXCEL中执行此操作。我试图将在AutoCAD VBA中工作的AutoCAD VBA例程修改为在EXCEL中工作，但我似乎错过了一些东西。请看下面我的代码。它在ss（0）处失败。。线
请告知
非常感谢。
Sub Get_BoundingBox()
Dim XNAME As String
'On Error Resume Next 'This tells VBA to ignore errors
Set ACAD = GetObject(, "AutoCAD.Application") 'Get a running instance of the class AutoCAD.Application
Dim ssetObj As AcadSelectionSet
Dim sset As AcadSelectionSets
Dim acadobj As AcadObject
Dim objname As String
Dim ptllmin As Variant
Dim ptllmax As Variant
Dim HH As Variant
Dim objlayer As String
Dim entItem As AcadEntity
Dim I As Integer
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double
corner1(0) = -10000000000#: corner1(1) = -10000000000#: corner1(2) = 0
corner2(0) = 10000000000#: corner2(1) = 10000000000#: corner2(2) = 0
I = 0
Set sset = ACAD.ActiveDocument.SelectionSets
For Each ssetObj In sset
If UCase(ssetObj.Name) = "TEST" Then
sset.Item("TEST").Delete
Exit For
End If
Next
Set ssetObj = ACAD.ActiveDocument.SelectionSets.Add("TEST")
' Add all the objects to the selection set
ssetObj.Select acSelectionSetAll
Q$ = Chr(9)
For Each acadobj In ssetObj
objname = acadobj.ObjectName
objlayer = acadobj.Layer
HH = acadobj.Handle
Const X = 0
Const Y = 1
ss(0).GetBoundingBox ptMin, ptMax
For Each entItem In ss
ACAD.ActiveDocument.entItem.GetBoundingBox ptllmin, ptllmax
If ptllmin(X) < ptMin(X) Then ptMin(X) = ptllmin(X)
If ptllmin(Y) < ptMin(Y) Then ptMin(Y) = ptllmin(Y)
If ptllmax(X) > ptMax(X) Then ptMax(X) = ptllmax(X)
If ptllmax(Y) > ptMax(Y) Then ptMax(Y) = ptllmax(Y)
Next
Sheet5.Cells(I, 1).Value = I
Debug.Print objname, Q$, objlayer, Q$, HH
I = I + 1
Sheet5.Cells(I, 1).Value = I
Sheet5.Cells(I, 2).Value = objname
Sheet5.Cells(I, 3).Value = objlayer
Sheet5.Cells(I, 4).Value = HH
Sheet5.Cells(I, 5).Value = ptMin(X)
Sheet5.Cells(I, 6).Value = ptMin(Y)
Sheet5.Cells(I, 7).Value = ptMax(X)
Sheet5.Cells(I, 7).Value = ptMax(Y)
Next acadobj
End Sub
我不是VBA方面的专家，但是比较一下lee mac的代码，你会发现调用边界框时缺少了一个对象。
(vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))
同样ss（0）可能只是ss，为什么边界框调用两次？
同时查看变量extmax extmin
lisp版本
(setq ss (ssget))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))
(vla-getboundingbox obj 'll 'ur)
(setq ll(vlax-safearray->list ll))
(setq ur (vlax-safearray->list ur))
(princ ll)
)
页:
[1]