Объекты

Public Function SelectByIntersection(objEnt As AcadEntity) As AcadSelectionSet
  Dim objGen As AcadEntity
  Dim objSelSet As AcadSelectionSet
  Dim objSelCol As AcadSelectionSets
  Dim objArray() As Object
  Dim strName As String
  Dim varMin As Variant
  Dim varMax As Variant
  Dim varIntPnt As Variant
  Dim intcnt As Integer
  On Error GoTo Err_Control
  objEnt.GetBoundingBox varMin, varMax
  strName = "vbdintersect"
  Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = strName Then
        ThisDrawing.SelectionSets.Item(strName).Delete
        Exit For
      End If
    Next
  Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
  objSelSet.Select acSelectionSetCrossing, varMin, varMax
  For Each objGen In objSelSet
    varIntPnt = objEnt.IntersectWith(objGen, acExtendNone)
    If UBound(varIntPnt) = -1 Then
      ReDim Preserve objArray(intcnt)
      Set objArray(intcnt) = objGen
      intcnt = intcnt + 1
    End If
    varIntPnt = Empty
  Next
  If IsEmpty(objArray) Then
    Set SelectByIntersection = objSelSet
  Else
    objSelSet.RemoveItems objArray
    Set SelectByIntersection = objSelSet
  End If
Exit_Here:
  Exit Function
  MsgBox Err.Description
  Resume Exit_Here
End Function
‘A Very simple (and pointless) test
Public Sub TEST_SelectByIntersection ()
  Dim objSS As AcadSelectionSet
  Dim objToCheck As AcadEntity
  Dim varPnt As Variant
  Dim objThatIntersects As AcadEntity
  ThisDrawing.Utility.GetEntity objToCheck, varPnt, "Select an object: "
  Set objSS = SelectByIntersection(objToCheck)
  For Each objThatIntersects In objSS
    objThatIntersects.Highlight True
  Next
  If MsgBox("Выбранный объект пересекает " & CStr(objSS.Count) & _
            " объектов." & vbCrLf & "Удалить эти объекты?", _
            vbQuestion + vbYesNo, "TEST_SelectByIntersection") = vbYes Then
    For Each objThatIntersects In objSS
      objThatIntersects.Delete
    Next
  Else
      For Each objThatIntersects In objSS
        objThatIntersects.Highlight False
      Next
  End If
End Sub