Ml, below seems to work. I both love and hate begincommand, the escape sequences are tricky,
but this doesn't seem to have that problem.
Explode deletes the blockref at some point as shown by
Private Sub AcadDocument_ObjectErased(ByVal ObjectID As Long)
MsgBox ObjectID
End Sub
So perhaps there is an efficient way to use that useless now defunct objectid
but selectionsets are fast
so below may be your best shot.
Option Explicit
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
Debug.Print CommandName
If CommandName = "EXPLODE" Then
Dim SStart As AcadSelectionSet
Set SStart = sset(2, "xarw", "SStart")
End If
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CommandName = "EXPLODE" Then
Dim SEnd As AcadSelectionSet
Set SEnd = sset(2, "xarw")
If ThisDrawing.SelectionSets("SStart").Count > SEnd.Count Then
MsgBox "Behave"
ThisDrawing.SendCommand "Undo 1 "
End If
End If
End Sub
Public Function sset(Optional FilterType, Optional FilterData As Variant, Optional ssName As String = "SS") As AcadSelectionSet
Dim oSSets As AcadSelectionSets
Set oSSets = ThisDrawing.SelectionSets
For Each sset In oSSets
If sset.Name = ssName Then
sset.Delete
Exit For
End If
Next
Set sset = ThisDrawing.SelectionSets.Add(ssName)
If IsMissing(FilterData) Then
sset.Select 5
Exit Function
End If
Dim FType() As Integer
Dim FData() As Variant
Dim I As Integer
If IsArray(FilterType) = False Then
If IsArray(FilterData) = False Then
ReDim FType(0)
ReDim FData(0)
FType(0) = FilterType
FData(0) = FilterData
Else
Exit Function
End If
Else
If UBound(FilterType) <> UBound(FilterData) Then
Exit Function 'They must be pairs
End If
ReDim FType(UBound(FilterType))
ReDim FData(UBound(FilterType))
For I = 0 To UBound(FilterType)
FType(I) = FilterType(I)
FData(I) = FilterData(I)
Next
End If
sset.Select 5, FilterType:=FType, FilterData:=FData
End Function
