Block Attributes to Text Error

[habakay]

I try to add Text object at the same point with Block object.

But it gave an error at red line below.

 

Error Code is;

Run-time error '5':

Invalid prosedure call or argument

 

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

[RICVBA]

just declare MidPoint as double

Dim MidPoint(0 To 2) As Double

 

also, though having nothing to do with the problem you encountered, you must also change last two lines at the bottom, adding the "set" keyword at their begininng

Set oText = Nothing
Set obj = Nothing