[求助]请教如何用VBA生成一个带属性的匿名块

Sub InstBlk()
    '插入一个含有自定义属性的匿名块
    '添加一个圆
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "*U")
    Dim circleObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 0: center(1) = 0: center(2) = 0
    radius = 1
    Set circleObj = blockObj.AddCircle(center, radius)
    '添加一个属性
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    ' 定义属性定义
    height = 1#
    mode = acAttributeModeNormal
    prompt = "新提示"
    insertionPoint(0) = 0#: insertionPoint(1) = 0#: insertionPoint(2) = 0
    tag = "新标签"
    value = "显示的属性值"
    ' 在模型空间中创建属性定义对象
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
    attributeObj.Invisible = False
    attributeObj.Alignment = acAlignmentMiddleCenter
    Dim BlkName As String
    BlkName = GetUNBlock
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, BlkName, 1#, 1#, 1#, 0)
End Sub
Public Function GetUNBlock() As String
    Dim blockObj As AcadBlock
    Dim n As Integer
    For Each blockObj In ThisDrawing.Blocks
        If Left(blockObj.Name, 1) = "*" Then
            If blockObj.Name  "*Model_Space" And Left(blockObj.Name, 12)  "*Paper_Space" Then
                If Mid(blockObj.Name, 3) >= n Then
                    n = Mid(blockObj.Name, 3)
                    GetUNBlock = blockObj.Name
                End If
            End If
        End If
    Next
    Set blockObj = Nothing
End Function