Как я могу сослаться на блок AutoCAD

Question

У меня есть проект AutoCAD, где 1 динамический блок, который я пытаюсь изменить из Excel. Вот скрипт vba, который я использую для изменения блока:

Dim dybprop As Variant, i As Integer
Dim bobj As AcadEntity

For Each bobj In ACADApp.ModelSpace
    If bobj.ObjectName = "AcDbBlockReference" Then
        If bobj.IsDynamicBlock Then
            If bobj.EffectiveName = "AdjBlock" Then
                dybprop = bobj.GetDynamicBlockProperties
                For i = LBound(dybprop) To UBound(dybprop)
                    If dybprop(i).PropertyName = "Distance1" Then
                        dybprop(i).Value = 50.75
                        Acad.Application.Update
                    End If
                Next i
            End If
        End If
    End If
Next

End With

Когда я запускаю его в AutoCAD VBA, он работает отлично. Затем я создаю проект Excel VBA и копирую этот код. Перед запуском я создаю подключение к существующему проекту AutoCad следующим образом:

  On Error Resume Next

   Dim ACADApp As AcadApplication
   Dim a As Object

   Set a = GetObject(, "AutoCAD.Application")

   If a Is Nothing Then
      Set a = CreateObject("AutoCAD.Application")

      If a Is Nothing Then
         MsgBox "AutoCAD must be running before performing this action.", vbCritical
         Exit Sub
      End If
   End If

   Set ACADApp = a

   Set ACADApp.ActiveDocument = ACADApp.Documents.Open("c:\KIRILL\Programming\Drawing1_VBATest.dwg")

Когда я запускаю его из Excel VBA - появляется проект AutoCAD, но ничего не меняется. Честно говоря, я понятия не имею, почему в Excel VBA это не работает, а в AutoCAD это работает. Может быть, у кого-то была эта проблема раньше? Заранее спасибо.

PS Полный код Excel VBA:

Sub Button9_Click()

  On Error Resume Next

   Dim ACADApp As AcadApplication
   Dim a As Object

   Set a = GetObject(, "AutoCAD.Application")

   If a Is Nothing Then
      Set a = CreateObject("AutoCAD.Application")

      If a Is Nothing Then
         MsgBox "AutoCAD must be running before performing this action.", vbCritical
         Exit Sub
      End If
   End If

   Set ACADApp = a

   Set ACADApp.ActiveDocument = ACADApp.Documents.Open("c:\KIRILL\Programming\Drawing1_VBATest.dwg")

Dim dybprop As Variant, i As Integer
Dim bobj As AcadEntity

For Each bobj In ACADApp.ModelSpace
    If bobj.ObjectName = "AcDbBlockReference" Then
        If bobj.IsDynamicBlock Then
            If bobj.EffectiveName = "AdjBlock" Then
                dybprop = bobj.GetDynamicBlockProperties
                For i = LBound(dybprop) To UBound(dybprop)
                    If dybprop(i).PropertyName = "Distance1" Then
                        dybprop(i).Value = 50.75
                        Acad.Application.Update
                    End If
                Next i
            End If
        End If
    End If
Next



End Sub

Answer 1

Вы пытались добавить справочную библиотеку?

Ты можешь пойти в:

Tools-> References

И добавить:

[Библиотека типов AutoCAD 20xx]