Последовательная переименовка одноименных атрибутов

'Получение атрибутов (редактируемых) блока и вывод их в MsgBox
Sub GetBlockAttr()
Dim objBlock As AcadBlock, objBlockRef As AcadBlockReference
Dim objAttr As AcadAttribute
Dim SelSet As AcadSelectionSet
Dim SelBlock As AcadBlockReference
Dim sSelSetName As String, sBlockAttr As String
Dim filterType(0) As Integer
Dim filterData(0) As Variant
Dim blcAttr As Variant
Dim blcAttrCounter As Long, lCounter As Long
  filterType(0) = 0
  filterData(0) = "INSERT"
  sSelSetName = "SelectionForGetBlockAttr"
  For lCounter = 0 To ThisDrawing.SelectionSets.Count
    If ThisDrawing.SelectionSets.Item(lCounter).Name = sSelSetName Then
      ThisDrawing.SelectionSets.Item(lCounter).Clear
      ThisDrawing.SelectionSets.Item(lCounter).Delete
      Exit For
    End If
  Next 'lCounter
  Set SelSet = ThisDrawing.SelectionSets.Add(sSelSetName)
  SelSet.SelectOnScreen
  sBlockAttr = ""
  For lCounter = 1 To SelSet.Count
    Set SelBlock = SelSet.Item(lCounter - 1)
    blcAttr = SelBlock.GetAttributes
    For blcAttrCounter = LBound(blcAttr) To UBound(blcAttr)
      sBlockAttr = sBlockAttr + "; Tag: " + blcAttr(blcAttrCounter).TagString + _
                        "; Value: " + blcAttr(blcAttrCounter).TextString
    Next  'blcAttrCounter
    sBlockAttr = sBlockAttr + vbCr
  Next 'lCounter
  'Удаление SelSet
  SelSet.Clear
  SelSet.Delete
  MsgBox sBlockAttr
End Sub

Dim MyBlock As AcadBlock
Dim MyBlocks As AcadBlocks
Dim MyBlockReference As AcadBlockReference
Dim Atts As Variant
Public Function SelectMyBlocks(strName As String) As AcadSelectionSet
  Dim objSelSet As AcadSelectionSet
  Dim objSelCol As AcadSelectionSets
  Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = strName Then
        objSelSet.Delete
        Exit For
      End If
    Next
  Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
  Set SelectMyBlocks = objSelSet
End Function
 Public Sub GetMyBlockRefAtts()
  Dim objSelSet As AcadSelectionSet
  Dim objBlkRef As AcadBlockReference
  Dim intType(0) As Integer
  Dim varDat(0) As Variant
  Dim strAttributes As String
  Dim i As Integer
  Dim s As Integer
  s = 1
  On Error GoTo Err_Control
    intType(0) = 0
    varDat(0) = "INSERT"
    Set objSelSet = SelectMyBlocks("blocks")
    objSelSet.Select acSelectionSetAll, FilterType:=intType, _
    FilterData:=varDat
    For Each MyBlockReference In objSelSet
        Atts = MyBlockReference.GetAttributes
        For i = LBound(Atts) To UBound(Atts)
        strAttributes = strAttributes & "  Tag: " & Atts(i).TagString & "   Value: " & Atts(i).TextString & "    "
        If Atts(i).TagString = "НОМЕР" Then
        Atts(i).TextString = s
        s = s + 1
        End If
        Next i
        Next MyBlockReference
Exit_Here:
  Exit Sub
Err_Control:
  MsgBox Err.Description
  Resume Exit_Here
End Sub