Удаление слоя

Option Explicit
Sub PurgeLayer()
ThisDrawing.SendCommand "-PURGE" & vbCr & "LA" & vbCr & _
"MyLayer" & vbCr & "Y" & vbCr & "Y" & vbCr
End Sub

Option Explicit
'' written by Fatty T.O.H (c)2006 * all rights removed
'' based on idea by Jeff Mishler
Sub ch_AttLayer()
Dim ownerObj As AcadObject
Dim oBlock As AcadBlock
Dim oAttrib As AcadAttribute
Dim oAttRef As AcadAttributeReference
Dim varPt As Variant
Dim subObj As AcadObject
Dim itmObj As AcadObject
Dim blkName As String, strTag As String
Dim lngId As Long
Dim tmax, cxdata
Dim i, j As Long
Dim blkHdl As String
On Error GoTo Err_Trapp
ThisDrawing.Utility.GetSubEntity subObj, varPt, tmax, cxdata, "Select a block subentity"
If TypeOf subObj Is AcadAttributeReference Then
Set oAttRef = subObj
strTag = oAttRef.TagString
Else
MsgBox "Wrong type of selected object"
Exit Sub
End If
lngId = subObj.OwnerID
Set ownerObj = ThisDrawing.ObjectIdToObject(lngId)
blkName = ownerObj.Name
Debug.Print blkName
strLayer = InputBox("Enter layer name" & vbCr & "to offset attribute on: ", "New Attribute Layer")
Set oBlock = ThisDrawing.Blocks(blkName)
For i = 0 To oBlock.Count - 1
Set itmObj = oBlock.Item(i)
If TypeOf itmObj Is AcadAttribute Then
Set oAttrib = itmObj
If oAttrib.TagString = strTag Then
oAttrib.Layer = strLayer
End If
End If
Next i
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim fcode(2) As Integer
Dim fData(2) As Variant
Dim dxfcode, dxfdata
Dim setName As String
Dim attVar As Variant
fcode(0) = 0
fData(0) = "INSERT"
fcode(1) = 2
fData(1) = blkName
fcode(2) = 66
fData(2) = 1
dxfcode = fcode
dxfdata = fData
setName = "$Blocks$"
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.Select acSelectionSetAll, , , dxfcode, dxfdata
Debug.Print oSset.Count
For Each oEnt In oSset
Set oBlkRef = oEnt
attVar = oBlkRef.GetAttributes
For i = 0 To UBound(attVar)
Set oAttRef = attVar(i)
If oAttRef.TagString = strTag Then
oAttRef.Layer = strLayer
End If
Next i
Next oEnt
ThisDrawing.Regen acActiveViewport
Exit Sub
Err_Trapp:
If Err Then
MsgBox Err.Description
End If
End Sub

Function NormAttr(blkRef As AcadBlockReference) As AcadBlockReference
Dim blk As AcadBlock
Dim SubEnt As AcadObject
  blk = ThisDrawing.Blocks.Item(blkRef.Name)
  For Each SubEnt In blk
    SubEnt.Layer = "0"
  Next SubEnt
  For Each SubEnt In blkRef
    If SubEnt.ObjectName Like "*" & "Attribute" & "*" Then
      SubEnt.Layer = blkRef.Layer.Name
    End If
  Next SubEnt
  blkRef
End Function