Public Sub purge()
    Dim obj As Object
    For Each obj In ModelSpace
        If TypeName(obj) = "IAcadBlockReference" Then
            Dim blckref As AcadBlockReference
            Set blckref = obj
            If blckref.Name = "test" Then
                blckref.Delete
            End If
        End If
    Next
End Sub

Option Explicit

Public Sub EraseBlocks(Optional sBlockName As String)
Dim blkRef As AcadBlock
  If IsMissing(sBlockName) Then sBlockName = "*"
  On Error Resume Next
  For Each blkRef In ThisDrawing.Blocks
    blkRef.Erase
  Next blkRef
Dim oLayout As AcadLayout, blkLay As AcadBlock, oEnt As AcadEntity
  For Each oLayout In ThisDrawing.Layouts
    Set blkLay = oLayout.Block
    For Each oEnt In blkLay
      If oEnt.ObjectName = "AcDbBlockReference" And UCase(oEnt.Name) Like UCase(sBlockName) Then
        oEnt.Delete
      End If
    Next oEnt
  Next oLayout
End Sub

Type typLayer
  oPointer As Object
  IsLock As Boolean
  IsFrozen As Boolean
End Type

Public Sub ExplodeBlocksExcule(Optional sBlockNameExclude As String)
  If IsMissing(sBlockNameExclude) Then
    sBlockNameExclude = "*"
  Else
    sBlockNameExclude = UCase(sBlockNameExclude)
  End If
Dim oLayer As AcadLayer, arLayers() As typLayer, iCounter As Integer
  ReDim arLayers(ThisDrawing.Layers.Count - 1)
  iCounter = 0
On Error Resume Next
  For Each oLayer In ThisDrawing.Layers
    arLayers(iCounter).oPointer = oLayer
    arLayers(iCounter).IsFrozen = oLayer.Freeze
    arLayers(iCounter).IsLock = oLayer.Lock
    oLayer.Freeze = False
    oLayer.Lock = False
  Next oLayer
On Error GoTo 0
Dim oBlockDef As AcadBlock, oEnt As AcadEntity
  For Each oBlockDef In ThisDrawing.Blocks
    For Each oEnt In oBlockDef
      If oEnt.ObjectName = "AcDbBlockReference" And UCase(oEnt.Name) Like sBlockNameExclude Then
        oEnt.Explode
        oEnt.Erase
      End If
    Next oEnt
  Next oBlockDef
On Error Resume Next
  For iCounter = 0 To UBound(arLayers)
    arLayers(iCounter).oPointer.Lock = arLayers(iCounter).IsLock
    arLayers(iCounter).oPointer.Freeze = arLayers(iCounter).IsFrozen
  Next iCounter
End Sub

Sub Test()
  ExplodeBlocksExcule 'разбить вообще все блоки
End Sub

Sub Test1()
  ExplodeBlocksExcule "2" 'Разбить все блоки с именем "2"
End Sub

Sub Test2()
  ExplodeBlocksExcule "*2*" ' Разбить все блоки с именами, в которых содержится цифра 2
End Sub

If Not (ThisDrawing.Layers.Item(objSelSet.Item(i).Layer).Lock) Then
objSelSet.Item(i).Explode
objSelSet.Item(i).Erase
End If

(defun execute-command (cmdname)
  (command cmdname)
  (while (/= (getvar "cmdactive") 0)
    (command pause)
    );_ end of while
  );_ end of defun

ThisDrawing.SendCommand "(execute-command " & Chr(34) & ИмяВыполняемойКоманды & Chr(34) & ")" & vbCr

(defun execute-magiexp ()
  (command magiexp "" "_all" "" "")
  (while (/= (getvar "cmdactive") 0)
    (command pause)
    );_ end of while
  );_ end of defun

ThisDrawing.Layouts - 1

Function GetAllViewPorts() As Variant
Dim Res() As Object
Dim oLayout As AcadLayout, oEnt As AcadEntity
  For Each oLayout In ThisDrawing.Layouts
    If Not (UCase(oLayout.Name) Like "*[*]") Then
      On Error GoTo lErrorReDim
      For Each oEnt In oLayout.Block
        If oEnt.ObjectName = "AcDbViewport" Then
          ReDim Preserve Res(UBound(Res) + 1)
          Set Res(UBound(Res)) = oEnt
        End If
      Next oEnt
    End If
  Next oLayout
  GetAllViewPorts = Res
  Exit Function
lErrorReDim:
  ReDim Res(0)
  Resume Next
End Function

Sub Test()
Dim arVP As Variant
  arVP = GetAllViewPorts
End Sub

  For Each oLayout In ThisDrawing.Layouts 'По каждому объекту пространства в коллекции пространств
    If Not (UCase(oLayout.Name) Like "*[*]") Then ' Если имя не содержит символа "*"
      On Error GoTo lErrorReDim ' Ну, это обработчик ошибок, ничего нестандартного
      For Each oEnt In oLayout.Block ' По каждому объекту внутри пространства. Пофигу какому - объект есть, его обрабатываем
        If oEnt.ObjectName = "AcDbViewport" Then 'Если имя объекта AcDbViewport, т.е. объект является ВЭ
          ReDim Preserve Res(UBound(Res) + 1) 'В массив результатов добавить 1 элемент
          Set Res(UBound(Res)) = oEnt 'И только что добавленному элементу массива присвоить указатель на обрабатываемый примитив
        End If
      Next oEnt
    End If
  Next oLayout

Option Explicit

Type LayerEnt
  name As String
  IsLocked As Boolean
  IsFrozen As Boolean
End Type

Private Function LayerStatusSave() As LayerEnt()
Dim res() As LayerEnt, ArSize As Integer
Dim LayerItem As AcadLayer
  For Each LayerItem In ThisDrawing.Layers
    If Not (LayerItem.name Like "*|*") Then
      On Error GoTo lErrorReDim
      ReDim Preserve res(UBound(res))
      ArSize = UBound(res)
      res(ArSize).name = LayerItem.name
      res(ArSize).IsLocked = LayerItem.Lock
      res(ArSize).IsFrozen = LayerItem.Freeze
      On Error Resume Next
      LayerItem.Lock = False
      LayerItem.Freeze = False
    End If
  Next
  LayerStatusSave = res
  Exit Function
lErrorReDim:
  ReDim res(0)
  Resume Next
End Function

Private Function LayerStatusRestore(ByRef LayerStatusList() As LayerEnt)
Dim Item As Integer
  With ThisDrawing.Layers
    For Item = LBound(LayerStatusList) To UBound(LayerStatusList)
      On Error Resume Next
      .Item(LayerStatusList(Item).name).Lock = LayerStatusList(Item).IsLocked
      .Item(LayerStatusList(Item).name).Freeze = LayerStatusList(Item).IsFrozen
    Next
  End With
  ReDim LayerStatusList(0)
  On Error GoTo 0
End Function

Public Sub test()
Dim lst() As LayerEnt, SelSetName As String, SelSet As AcadSelectionSet
Dim dxtInt() As Integer, dxfType() As Variant
  SelSetName = "lavteam_selectionset"
  On Error Resume Next
  With ThisDrawing.SelectionSets
    .Item(SelSetName).Clear
    .Item(SelSetName).Delete
    Set SelSet = .Add(SelSetName)
    ReDim dxfint(0): ReDim dxfType(0)
    dxfint(0) = 0: dxfType(0) = "TEXT"
    SelSet.Select acSelectionSetAll, dxfint, dxfType
  End With
    
  lst = LayerStatusSave()
  Dim objpointer As AcadEntity
  For Each objpointer In SelSet
    ' Делаем чего-то
    objpointer.color = acRed
  Next
  LayerStatusRestore lst
  ThisDrawing.Regen acAllViewports
End Sub