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) = -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