Вставка блока через Sendcommand > fatal error.

Option Explicit
'InsertEnd = DoEvents.
'здесь InsertEnd — формальный параметр помогающий корректно вписать в код функцию DoEvents.
Public Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
Sub cmdTest()
    Dim InsertEnd As Integer
    Dim k As Integer
    On Error Resume Next
    ThisDrawing.SendCommand "_find "
    Do
        InsertEnd = DoEvents
        Sleep 100 'pause 0.1 sec
        k = ThisDrawing.GetVariable("CMDACTIVE")
    Loop While (k > 0)
    MsgBox "Exit successful!"
End Sub

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If Prov_End_Command = 1 Then
   UserForm1.Show
End If
End Sub

Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Function IsBlockExist(bName As String) As Boolean
   Dim oBlock As AcadBlock
   IsBlockExist = False
   For Each oBlock In ThisDrawing.Blocks
   If StrComp(oBlock.Name, bName, vbTextCompare) = 0 Then
   IsBlockExist = True
   End If
   Next
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Function IsLayerExist(lName As String) As Boolean
   Dim oLayer As AcadLayer
   IsLayerExist = False
   For Each oLayer In ThisDrawing.Layers
   If StrComp(oLayer.Name, lName, vbTextCompare) = 0 Then
   IsLayerExist = True
   End If
   Next
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Sub InsertWithGhostImage()
     Dim blkName As String, layName As String
     Dim osm, clr, pt
     Dim strPt As String, comStr As String
     blkName = InputBox(vbCrLf & "Block name to be insert:", "Insert Block")
     If blkName = vbNullString Then Exit Sub
     If Not IsBlockExist(blkName) Then
     MsgBox "Block " & Chr(34) & blkName & Chr(34) & " does not exist"
     Exit Sub
     End If
     layName = InputBox(vbCrLf & "Layer name to insert block on:", "Insert Block", "0")
     If Not IsLayerExist(layName) Then
     MsgBox "Layer " & Chr(34) & layName & Chr(34) & " does not exist"
     Exit Sub
     End If
     With ThisDrawing
          On Error GoTo Err_Control
          osm = .GetVariable("OSMODE")
          clr = .GetVariable("CLAYER")
          .Utility.Prompt vbCrLf & "   Specify insertion point of block  >>"
          .SetVariable "CLAYER", layName     '<-- layer name you need
          .SetVariable "EXPERT", 2     '<-- suppress any prompts in the command line
          .SetVariable "FILEDIA", 0     '<-- suppress display file dialog box if block is drawing
          .SetVariable "ATTDIA", 0     '<-- suppress attribute dialog
          .SetVariable "ATTREQ", 0     '<-- suppress prompt to verify attribute value
          .SetVariable "OSMODE", 0     '<-- turn snap mode off
          .SetVariable "CMDECHO", 0     '<-- suppress command echo
          comStr = "(command " & _
                   Chr(34) & "._-insert" & Chr(34) & _
                   vbCr & Chr(34) & blkName & _
                   Chr(34) & " pause" & vbCr & _
                   Chr(34) & "1" & Chr(34) & _
                   vbCr & Chr(34) & "1" & Chr(34) & _
                   vbCr & Chr(34) & "0" & Chr(34) & ")"
                   .SendCommand comStr & vbCr
          DoEvents
          Dim oSpace As AcadBlock
          Dim oblkRef As AcadBlockReference
          If .ActiveSpace = acModelSpace Then
               Set oSpace = .ModelSpace
          Else
               Set oSpace = .PaperSpace
          End If
          Set oblkRef = oSpace.Item(oSpace.Count - 1)
          Debug.Print oblkRef.EffectiveName
     End With
Exit_Here:
     With ThisDrawing
          .SetVariable "CLAYER", clr
          .SetVariable "EXPERT", 0
          .SetVariable "FILEDIA", 1
          .SetVariable "ATTDIA", 1
          .SetVariable "ATTREQ", 1
          .SetVariable "OSMODE", osm
          .SetVariable "CMDECHO", 1
     End With
     Exit Sub
Err_Control:
     MsgBox Err.Description
     Resume Exit_Here
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Dim varAttributes As Variant
Dim count As Integer
count = ThisDrawing.ModelSpace.count
ReDim ACADObject(count) As AcadEntity
Set ACADObject(count) = ThisDrawing.ModelSpace.Item(count - 1)
varAttributes = ACADObject(count).GetAttributes
varAttributes(0).TextString = TextBox1.value

Sub SendCommand(str)
  Select Case ComboBox19.value
     Case "Указать"
         ThisDrawing.SendCommand "._-insert" & vbCr & str & vbCr & "Масштаб" & vbCr & "1" & vbCr
    Case Else
       ThisDrawing.SendCommand "._-insert" & vbCr & str & vbCr & "Масштаб" & vbCr & "1" & vbCr & "ПОворот" & vbCr & ComboBox19.value & vbCr
  End Select
Prov_End_Command = 0
End Sub