'@~~~~ Get the bounding box of a selection set ~~~~@
Public Function GetSSBoundingBox(Min As Variant, _
Max As Variant, objSet As AcadSelectionSet) As Boolean
Dim dblMaxX As Double
Dim dblMaxY As Double
Dim dblMinX As Double
Dim dblMinY As Double
Dim varMin As Variant
Dim varMax As Variant
Dim objEnt As AcadEntity
Dim objUtil As Object
On Error GoTo Err_Control
Set objUtil = ThisDrawing.Utility
objSet.Item(0).GetBoundingBox varMin, varMax
dblMinX = varMin(0)
dblMinY = varMin(1)
dblMaxX = varMax(0)
dblMaxY = varMax(1)
'Get the highs and lows
For Each objEnt In objSet
objEnt.GetBoundingBox varMin, varMax
If varMin(0) < dblMinX Then
dblMinX = varMin(0)
End If
If varMin(1) < dblMinY Then
dblMinY = varMin(1)
End If
If varMax(0) > dblMaxX Then
dblMaxX = varMax(0)
End If
If varMax(1) > dblMaxY Then
dblMaxY = varMax(1)
End If
Next objEnt
'Fill the arrays
objUtil.CreateTypedArray Min, vbDouble, dblMinX, dblMinY, 0
objUtil.CreateTypedArray Max, vbDouble, dblMaxX, dblMaxY, 0
GetSSBoundingBox = True
Exit_Here:
Exit Function
Err_Control:
MsgBox Err.Description
Resume Exit_Here
End Function
Public Sub Test_GetSSBoundingBox()
Dim acSelSet As AcadSelectionSet
Dim varMin As Variant
Dim varMax As Variant
Dim dblPnts(0 To 5) As Double
Set acSelSet = ThisDrawing.SelectionSets.Add("TestGetSSBB")
acSelSet.SelectOnScreen
GetSSBoundingBox varMin, varMax, acSelSet
ZoomWindow varMin, varMax
End Sub