Объекты вне выделенной рамки

Option Explicit
' Delete objects outside the box
Sub DeleteOutsideTheBox()
    Dim osSAll As AcadSelectionSet
    Dim osSBox As AcadSelectionSet
    Dim oEnt As AcadEntity
    Dim minPt As Variant
    Dim maxPt As Variant
    Dim i As Integer
    With ThisDrawing.SelectionSets
        While .Count > 0
            .Item(0).Delete
        Wend
        Set osSAll = .Add("$ALL$")
        Set osSBox = .Add("$INBOX$")
    End With
    osSAll.Select acSelectionSetAll
    If osSAll.Count = 0 Then Exit Sub
    Debug.Print "Selected: " & osSAll.Count & " objects." '<-- for debug only
    minPt = ThisDrawing.Utility.GetPoint(, "Specify first corner point:")
    maxPt = ThisDrawing.Utility.GetCorner(minPt, "Specify opposite corner point:")
    osSBox.Select acSelectionSetWindow, minPt, maxPt
    If osSBox.Count = 0 Then Exit Sub
    ReDim remObjs(0 To osSBox.Count - 1) As AcadEntity
    For i = 0 To osSBox.Count - 1
        Set oEnt = osSBox.Item(i)
        Set remObjs(i) = oEnt
    Next i
    osSAll.RemoveItems remObjs
    Debug.Print "Still in selection: " & osSAll.Count & " objects." '<-- dummy pause for ending process
    osSAll.Erase
    ZoomExtents
End Sub