Get bounding box from EXCEL

Get bounding box from EXCEL

Anonymous
Not applicable
1,290 Views
1 Reply
Message 1 of 2

Get bounding box from EXCEL

Anonymous
Not applicable

Hello,
I am trying to get the bounding box for all entities on a layer.
I would like to be able to do this from EXCEL. I tried to modify an AutoCAD VBA routine that works in the AutoCAD VBA to work in EXCEL, however I seem to miss something. Please see my code below. It fails at the ss(0).. line.
Please advise
Thank you


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) = -xxx-xxxxxxxx: corner1(1) = -xxx-xxxxxxxx: corner1(2) = 0
corner2(0) = xxx-xxxxxxxx: corner2(1) = xxx-xxxxxxxx: 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

0 Likes
1,291 Views
1 Reply
Reply (1)
Message 2 of 2

norman.yuan
Mentor
Mentor

Is this all code in the VBA module, or you have other code not showing? Because there is no declaration to the variable "ss" (i.e. Dim ss As AcadSelectionSet) in this portion of code.

 

If you do not have that declaration at module level, that is why the execution fails, because VBA does not know what "ss" is.

 

Or, if you do declare it at module level, but "ss" is not used to select anything (i.e. the selection set is empty), then the code "ss(0)" would result in error, because it is empty.

 

Well, without seeing all code, this is just a guess game.

 

Norman Yuan

Drive CAD With Code

EESignature

0 Likes