Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Namespace ExplosionPrevention
    Public Class Commands
        Private _doc As Document
        Private _db As Database
        Private _blkDefs As New ObjectIdCollection()
        Private _blkRefs As New ObjectIdCollection()
        Private _blkConts As New ObjectIdCollection()
        Private _handlers As Boolean = False
        Private _exploding As Boolean = False
        <CommandMethod("STOPEX")> _
        Public Sub StopBlockFromExploding()
            _doc = Application.DocumentManager.MdiActiveDocument
            _db = _doc.Database
            If Not _handlers Then
                AddEventHandlers()
                _handlers = True
            End If
            ' Get the name of the block to protect
            Dim pso As New PromptStringOptions(vbLf & "Enter block name: ")
            pso.AllowSpaces = False
            Dim pr As PromptResult = _doc.Editor.GetString(pso)
            If pr.Status <> PromptStatus.OK Then
                Return
            End If
            Dim tr As Transaction = _db.TransactionManager.StartTransaction()
            Using tr
                ' Make sure the block definition exists
                Dim bt As BlockTable = DirectCast(tr.GetObject(_db.BlockTableId, OpenMode.ForRead), BlockTable)
                If bt.Has(pr.StringResult) Then
                    ' Collect information about the block...
                    ' 1. the block definition
                    Dim blkId As ObjectId = bt(pr.StringResult)
                    _blkDefs.Add(blkId)
                    Dim btr As BlockTableRecord = DirectCast(tr.GetObject(blkId, OpenMode.ForRead), BlockTableRecord)
                    ' 2. the block's contents
                    For Each id As ObjectId In btr
                        _blkConts.Add(id)
                    Next
                    ' 3. the block's references
                    Dim blkRefs As ObjectIdCollection = btr.GetBlockReferenceIds(True, True)
                    For Each id As ObjectId In blkRefs
                        _blkRefs.Add(id)
                    Next
                End If
                tr.Commit()
            End Using
        End Sub
        Private Sub AddEventHandlers()
            ' When a block reference is added, we need to
            ' check whether it's for a block we care about
            ' and add it to the list, if so
            AddHandler _db.ObjectAppended, AddressOf _ObjectAppended
            AddHandler _db.ObjectErased, AddressOf _ObjectErased
            AddHandler _db.BeginDeepClone, AddressOf _BeginDeepClone
            AddHandler _db.BeginDeepCloneTranslation, AddressOf _BeginDeepCloneTranslation
        End Sub

        Sub _ObjectAppended(ByVal sender As Object, ByVal e As ObjectEventArgs)
            Dim br As BlockReference = TryCast(e.DBObject, BlockReference)
            If br IsNot Nothing Then
                If _blkDefs.Contains(br.BlockTableRecord) Then
                    _blkRefs.Add(br.ObjectId)
                End If
            End If
        End Sub
        ' Conversely we need to remove block references
        ' that as they're erased
        Sub _ObjectErased(ByVal sender As Object, ByVal e As ObjectErasedEventArgs)
            ' This is called during as part of the cloning 
            ' process, so let's check that's not happening
            If Not _exploding Then
                Dim br As BlockReference = TryCast(e.DBObject, BlockReference)
                If br IsNot Nothing Then
                    ' If we're erasing, remove this block
                    ' reference from the list, otherwise if
                    ' we're unerasing we will want to add it
                    ' back in
                    If e.Erased Then
                        If _blkRefs.Contains(br.ObjectId) Then
                            _blkRefs.Remove(br.ObjectId)
                        End If
                    Else
                        If _blkDefs.Contains(br.BlockTableRecord) Then
                            _blkRefs.Add(br.ObjectId)
                        End If
                    End If
                End If
            End If
        End Sub
        ' This is where we fool AutoCAD into thinking the
        ' block contents have already been cloned
        Sub _BeginDeepClone(ByVal sender As Object, ByVal e As IdMappingEventArgs)
            ' Only for the explode context
            If e.IdMapping.DeepCloneContext <> DeepCloneType.Explode Then
                Return
            End If
            ' We add IDs to the map to stop the
            ' block contents from being cloned
            For Each id As ObjectId In _blkConts
                e.IdMapping.Add(New IdPair(id, id, True, True, True))
            Next
        End Sub
        ' And this is where we remove the mapping entries
        Sub _BeginDeepCloneTranslation(ByVal sender As Object, ByVal e As IdMappingEventArgs)
            ' Only for the explode context
            If e.IdMapping.DeepCloneContext <> DeepCloneType.Explode Then
                Return
            End If
            ' Set the flag for our CommandEnded handler
            _exploding = True
            ' Remove the entries we added on BeginDeepClone
            For Each id As ObjectId In _blkConts
                e.IdMapping.Delete(id)
            Next
        End Sub
        ' As the command ends we unerase the block references
        Sub _CommandEnded(ByVal sender As Object, ByVal e As CommandEventArgs)
            If e.GlobalCommandName = "EXPLODE" AndAlso _exploding Then
                ' By this point the block contents should not have
                ' been cloned, but the blocks have been erased
                Dim tr As Transaction = _db.TransactionManager.StartTransaction()
                Using tr
                    ' So we need to unerase each of the erased
                    ' block references
                    For Each id As ObjectId In _blkRefs
                        Dim obj As DBObject = tr.GetObject(id, OpenMode.ForRead, True)
                        ' Only unerase it if it's needed
                        If obj.IsErased Then
                            obj.UpgradeOpen()
                            obj.[Erase](False)
                        End If
                    Next
                    tr.Commit()
                End Using
                _exploding = False
            End If
        End Sub

    End Class

End Namespace