Как прочитать значения Tag и Prompt атрибута?

Sub test()
Dim oSsets As AcadSelectionSets
Dim oSset As AcadSelectionSet
Dim oBlocks As AcadBlocks
Dim blkDef As AcadBlock
Dim blkRef As AcadBlockReference
Dim attRef As AcadAttributeReference
Dim itmObj As AcadObject
Dim i, j, k, n As Integer
Dim fType(1) As Integer
Dim fData(1) As Variant
Dim blkName, strTag, strPmt, strVal As String
Dim attColl As Collection
Dim pmtArr() As String
Dim attArr() As AcadAttributeReference
Dim attData() As Variant
Set attColl = New Collection
Set oBlocks = ThisDrawing.Blocks
Set oSsets = ThisDrawing.SelectionSets
For Each oSset In oSsets
If oSset.Name = "Only" Then
oSset.Delete
Exit For
End If
Next
Set oSset = ThisDrawing.SelectionSets.Add("Only")
fType(0) = 0: fType(1) = 66
fData(0) = "INSERT": fData(1) = 1 ''{DXF код 66 бит 1 для блоков с атрибутами}
oSset.SelectOnScreen fType, fData
j = 0
For n = 0 To oSset.Count - 1
Set blkRef = oSset.Item(n)
attArr = blkRef.GetAttributes
For i = 0 To UBound(attArr)
Set attRef = attArr(i)
attColl.Add attRef
Next i
blkName = blkRef.Name
Set blkDef = oBlocks.Item(blkName)
For k = 0 To blkDef.Count - 1
Set itmObj = blkDef.Item(k)
If TypeOf itmObj Is AcadAttribute Then
strPmt = itmObj.PromptString
ReDim Preserve pmtArr(j)
pmtArr(j) = strPmt
j = j + 1
End If
Next k
Next n
i = 0
ReDim attData(0 To attColl.Count - 1, 0 To 2)
For Each attRef In attColl
attData(i, 0) = attRef.TagString
attData(i, 1) = pmtArr(i) '' => {PromptString}
attData(i, 2) = attRef.TextString
i = i + 1
Next
End Sub

'|   Function GetAllAttributes
'|   Description:
'|   Get all attributes data include constant.
'|   Copyright: all rights removed
'|   ©2006
'|   Author: Fatty The Old Stupid Horse
'|   Arguments:
'|     - blkRef = AcadBlockReference
'|   Return:
'|     - Two dimensional array with tags and values
'|   Notes:
'|     - None
Public Function GetAllAttributes(ByVal blkRef As AcadBlockReference) As Variant
Dim atRef As Object
Dim verArr, cstArr, tmpArr As Variant
Dim attArr As New Collection
Dim attData() As Variant
Dim i, j As Integer
On Error GoTo ErrCheck
    If blkRef.HasAttributes Then
      '|  Get "usual" attributes
      verArr = blkRef.GetAttributes
      If UBound(verArr) >= LBound(verArr) Then
      For i = LBound(verArr) To UBound(verArr)
      attArr.Add verArr(i)
      Next i
      End If
      '|  Get constant attributes
      cstArr = blkRef.GetConstantAttributes
      If UBound(cstArr) >= LBound(cstArr) Then
        For i = LBound(cstArr) To UBound(cstArr)
        attArr.Add cstArr(i)
        Next i
      End If
    End If
    i = 0
    ReDim attData(attArr.Count - 1, 1)
    For Each atRef In attArr
    attData(i, 0) = atRef.TagString
    attData(i, 1) = atRef.TextString
    i = i + 1
    Next
ErrCheck:
MsgBox Err.Description
GetAllAttributes = attData
End Function

If TypeOf itmObj Is [b]AcadAttribute[/b] Then
strPmt = itmObj.PromptString