[编程交流] 块属性到文本错误

Sub Block_Attributes_to_Text()
Dim obj As AcadBlockReference
Dim oText As AcadText
Dim inspt As Variant
Dim AttList As Variant
Dim metin As String
Dim poz As String
Dim adet As String
Dim cap As String
Dim ara As String
Dim boy As String
Dim MidPoint(0 To 2)
Dim NewColorObject As AcadAcCmColor
Dim acı As Double
ThisDrawing.Utility.GetEntity obj, inspt, "Select Block:"
If obj.ObjectName = "AcDbBlockReference" Then
   If obj.HasAttributes Then
       AttList = obj.GetAttributes
       For i = LBound(AttList) To UBound(AttList)
           Select Case AttList(i).TagString
   
           Case Is = "POZ1"
               poz = AttList(i).TextString
           Case Is = "DAD"
               adet = AttList(i).TextString
           Case Is = "CAP"
               cap = AttList(i).TextString
           Case Is = "ARA"
               ara = AttList(i).TextString
           Case Is = "BOY1"
               boy = AttList(i).TextString
           End Select
       Next i
   End If
Else
   MsgBox "You did not select a block."
End If
       
    
       metin = poz & "+" & adet & "»" & cap & "/" & ara & " L=" & boy
       MidPoint(0) = obj.InsertionPoint(0)
       MidPoint(1) = obj.InsertionPoint(1)
       MidPoint(2) = 0
       [b][color=red]Set oText = ThisDrawing.ModelSpace.AddText(metin, MidPoint, 5)[/color][/b]
       Set NewColorObject = obj.TrueColor
       NewColorObject.ColorMethod = acColorMethodByACI
       NewColorObject.ColorIndex = 2
       oText.TrueColor = NewColorObject
           
       acı = obj.Rotation
       oText.Rotate MidPoint, acı
       oText.Update
acı = Empty
Set NewColorObject = Nothing
Erase MidPoint
boy = vbNullString
ara = vbNullString
cap = vbNullString
adet = vbNullString
poz = vbNullString
metin = vbNullString
AttList = Empty
inspt = Empty
oText = Nothing
obj = Nothing
End Sub

Dim MidPoint(0 To 2) As Double

Set oText = Nothing
Set obj = Nothing