命名层过滤器

Option Explicit
'Private Sub AcadDocument_BeginSave(ByVal FileName As String)
Sub purge_em()
Dim strSubName As String
Dim objDictionary As AcadDictionary
Dim objFilter As AcadObject
On Error GoTo Err_Ctrl
strSubName = "PurgeFilter.DVB"
Set objDictionary = ThisDrawing.Layers.GetExtensionDictionary("ACAD_LAYERFILTERS")
For Each objFilter In objDictionary
  objFilter.Delete
Next
If Left(ThisDrawing.GetVariable("ACADVER"), 2) = "16" Then
  Set objDictionary = ThisDrawing.Layers.GetExtensionDictionary("ACLYDICTIONARY")
  For Each objFilter In objDictionary
    objFilter.Delete
  Next objFilter
End If
Exit_Here:
  Exit Sub
  
Err_Ctrl:
  Select Case Err.Number
    Case -2145386476
      Err.Clear
      Resume Next
    Case Else
      MsgBox "An Error occurred in " & strSubName & "." & vbCr & vbCr _
        & "Error number: " & Err.Number & vbCr & Err.Description & vbCr & vbCr _
        & "DUM DIGga DUM DIGga DIGga DIGga DUM", vbCritical, _
        "Error in " & strSubName
      GoTo Exit_Here
  End Select
      
End Sub