Display full version of the post: VBA GetBox

katto01
16.07.2018, 17:38
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 adviseThank youSub Get_BoundingBox()Dim XNAME As String'On Error Resume Next 'This tells VBA to ignore errorsSet ACAD = GetObject(, "AutoCAD.Application") 'Get a running instance of the class AutoCAD.ApplicationDim ssetObj As AcadSelectionSetDim sset As AcadSelectionSetsDim acadobj As AcadObjectDim objname As StringDim ptllmin As VariantDim ptllmax As VariantDim HH As VariantDim objlayer As StringDim entItem As AcadEntityDim I As IntegerDim corner1(0 To 2) As DoubleDim corner2(0 To 2) As Doublecorner1(0) = -10000000000#: corner1(1) = -10000000000#: corner1(2) = 0corner2(0) = 10000000000#: corner2(1) = 10000000000#: corner2(2) = 0I = 0Set sset = ACAD.ActiveDocument.SelectionSetsFor Each ssetObj In ssetIf UCase(ssetObj.Name) = "TEST" Thensset.Item("TEST").DeleteExit ForEnd IfNextSet ssetObj = ACAD.ActiveDocument.SelectionSets.Add("TEST")' Add all the objects to the selection setssetObj.Select acSelectionSetAllQ$ = Chr(9)For Each acadobj In ssetObjobjname = acadobj.ObjectNameobjlayer = acadobj.LayerHH = 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)  NextSheet5.Cells(I, 1).Value = IDebug.Print objname, Q$, objlayer, Q$, HHI = I + 1Sheet5.Cells(I, 1).Value = ISheet5.Cells(I, 2).Value = objnameSheet5.Cells(I, 3).Value = objlayerSheet5.Cells(I, 4).Value = HHSheet5.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 acadobjEnd Sub