VBA (Excel) Чтение и Запись в Чертеж КОМПАСа

[Валерич]

И еще, почему-то для сборки работает, а для детали выдает ошибку 13 «Type mismatch»...

[Михаил88]

У меня работает и там и там.

[Михаил88]

Добрый день.
Может в приведенном выше примере property_keeper лучше получить от документа, а не от головного парта?

Добрый день. Я попробовал так Set property_keeper = kompas_document и так Set property_keeper = kompas_document_3d.
Не пойдет.
в attached_documents возвращается путь до активной сборки



Если сделать, как у меня в примере вывод сообщения будет такой.

[Михаил88]

У меня работает и там и там.

[Петрович-47]

И еще, почему-то для сборки работает, а для детали выдает ошибку 13 «Type mismatch»...

аналогично
"property_keeper" - пустой

[Валерич]

Set property_keeper =
kompas_document_3d
Для сборки и детали дает
.a|m3d и .cdw
part7 - для сборки только
.spw, для детали - ошибку

[Михаил88]

Демонстрация на детали.

https://disk.yandex.ru/i/13PAXN4pLQBjMg

Демонстрация на сборке

https://disk.yandex.ru/i/p2vbWXDZT1hXtg

[Петрович-47]

У меня вот так на детали

[Михаил88]

Можете попробовать добавить эти файлики в КОМПАС-Макро и запустить (a3m добавить на активной сборке, m3m на активной детали).

[Валерич]

Если нет связанных документов, метод .ObjectAttachedDocuments дает ОШИБКУ...
Как перехватить?

[p3452]

Добрый день.
Может в приведенном выше примере property_keeper лучше получить от документа, а не от головного парта?

+100500

[Михаил88]

Если нет связанных документов, метод .ObjectAttachedDocuments дает ОШИБКУ...
Как перехватить?

Почитайте в интернета, как перехватывать ошибки на vba. Информации много.

[Михаил88]

+100500

В 18.1 так не получишь информацию о привязанных чертежах и спецификациях.

[Валерич]

А, из Чертежа, как получить связанную Спецификацию?

[p3452]

В 18.1 так не получишь информацию о привязанных чертежах и спецификациях.

?
Все что для ЭТОГО нужно в v18 есть:
IPropertyKeeper
IProductDataManager
IProductDataManager.ObjectAttachedDocuments[]
GetExternalFilesNamesEx()

[Михаил88]

Вы меня не поняли. Суть я описал в сообщении #62, где я ответил на предложение от Slaviation.

[Михаил88]

А, из Чертежа, как получить связанную Спецификацию?

Код Выделить Развернуть

Set property_keeper = kompas_document
Set product_data_manager = kompas_document

attached_documents = product_data_manager.ObjectAttachedDocuments(property_keeper)


[Михаил88]

А, из Чертежа, как получить связанную Спецификацию?

Будет работать на моделях и на чертежах, если подключенных документов нет, тоже будет работать. По крайней мере, у меня в Компас 18.1 работает.

Код Выделить Развернуть

Sub GetConnectedDocuments()

    Dim application As KompasAPI7.IApplication
    Dim doc_type As String
    Dim kompas_document As KompasAPI7.IKompasDocument
    Dim kompas_document_3d As KompasAPI7.KompasDocument3D
    Dim part7 As KompasAPI7.part7
    Dim property_keeper As KompasAPI7.IPropertyKeeper
    Dim product_data_manager As KompasAPI7.IProductDataManager
    Dim attached_documents() As String
    Dim i As Integer
    Dim Output As String

    Set application = GetObject(, "Kompas.Application.7")
    Set kompas_document = application.ActiveDocument
   
    doc_type = kompas_document.DocumentType()
    'Проверка типа документа
    If doc_type = Kompas6Constants.ksDocumentDrawing Then
        Set property_keeper = kompas_document
    Else
        Set kompas_document_3d = kompas_document
        Set part7 = kompas_document_3d.TopPart
        Set property_keeper = part7
    End If
   
    Set product_data_manager = kompas_document

    ' Получаем массив с обработкой ошибок
    On Error Resume Next
    attached_documents = product_data_manager.ObjectAttachedDocuments(property_keeper)
    If Err.Number <> 0 Then
        Err.Clear
        ReDim attached_documents(0 To -1) ' Явно создаём пустой инициализированный массив
    End If
    On Error GoTo 0

    ' Проверяем инициализацию массива перед циклом
    On Error Resume Next
    Dim hasElements As Boolean
    hasElements = (UBound(attached_documents) >= LBound(attached_documents))
    If Err.Number <> 0 Then
        hasElements = False
        Err.Clear
    End If
    On Error GoTo 0

    ' Собираем элементы в строку только если есть элементы
    If hasElements Then
        For i = LBound(attached_documents) To UBound(attached_documents)
            Output = Output & "Элемент " & i & ": " & attached_documents(i) & vbCrLf
        Next i
    Else
        Output = "Подключённых документов нет"
    End If

    MsgBox Output, vbInformation, "Содержимое массива"
   
End Sub


[Михаил88]

У меня вот так на детали

А Вы попробуйте поменять, как предложил Slaviation.

Set property_keeper = kompas_document или так Set property_keeper = kompas_document_3d

У меня просто в 18.1 так не работает в моделях.

[Петрович-47]

... попробуйте поменять, как предложил Slaviation.

Set property_keeper = kompas_document или так Set property_keeper = kompas_document_3d...

Да, спасибо, так заработало, в обоих случаях