Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Namespace WeLikeToBlock
    Public Class Commands
        Public Class EraseOverrule
            Inherits ObjectOverrule
            Public Overrides Sub [Erase](ByVal dbObject As DBObject, ByVal erasing As Boolean)
                MyBase.[Erase](dbObject, erasing)
                Throw New Autodesk.AutoCAD.Runtime.Exception(ErrorStatus.NotApplicable)
            End Sub
        End Class
        Shared _theOverrule As EraseOverrule = Nothing
        <CommandMethod("PER")> _
        Public Shared Sub PreventErase()
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            If _theOverrule Is Nothing Then
                _theOverrule = New EraseOverrule()
                ObjectOverrule.AddOverrule(RXObject.GetClass(GetType(Line)), _theOverrule, False)
                ObjectOverrule.Overruling = True
                ed.WriteMessage(vbLf & "Preventing erasure of lines.")
                ed.WriteMessage(vbLf & "直线防删保护.")
            Else
                ObjectOverrule.RemoveOverrule(RXObject.GetClass(GetType(Line)), _theOverrule)
                _theOverrule.Dispose()
                _theOverrule = Nothing
                ed.WriteMessage(vbLf & "No longer preventing erasure of lines.")
                ed.WriteMessage(vbLf & "关闭直线防删保护.")
            End If
        End Sub
    End Class
End Namespace

Namespace WeLikeToWatch
    Public Class Commands
        Public Class EraseOverrule
            Inherits ObjectOverrule
            Public Overrides Sub [Erase](ByVal dbObject As DBObject, ByVal erasing As Boolean)
                MyBase.[Erase](dbObject, erasing)
                Dim Temp As String
                If erasing = True Then
                    Temp = "删除"
                Else
                    Temp = "撤销删除"
                End If
                Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbCrLf & "{0} {1} {2}.", dbObject.GetType.Name, "(" & dbObject.ObjectId.ToString & ")", Temp)
            End Sub
        End Class
        Shared _theOverrule As EraseOverrule = Nothing
        <CommandMethod("WER")> _
        Public Shared Sub WatchErasure()
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            If _theOverrule Is Nothing Then
                _theOverrule = New EraseOverrule()
                ObjectOverrule.AddOverrule(RXObject.GetClass(GetType(DBObject)), _theOverrule, False)
                ObjectOverrule.Overruling = True
                ed.WriteMessage(vbLf & "Watching erasure of database objects.")
                ed.WriteMessage(vbLf & "对象删除监视.")
            Else
                ObjectOverrule.RemoveOverrule(RXObject.GetClass(GetType(DBObject)), _theOverrule)
                _theOverrule.Dispose()
                _theOverrule = Nothing
                ed.WriteMessage(vbLf & "No longer watching erasure of database objects.")
                ed.WriteMessage(vbLf & "关闭对象删除监视.")
            End If
        End Sub
    End Class
End Namespace