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

[lavgirb]

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

Отсутствие связанных чертежей - штатная ситуация для КОМПАС.
По идее, программа не должна выдавать ошибку на штатных ситуациях.
Тут над использовать переменную типа Variant. Как и во многих других местах API КОМПАС.
У меня вот такая рабочая функция.

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

'===============================================================================
'
' Выявление связанных чертежей
'
Private Function GetAttachedDocuments(ByRef oKompDoc As KompasAPI7.KompasDocument, _
                        Optional ByVal bOnlyDraw As Boolean = True) As String()
   Dim vAttDocs      As Variant
   Dim vAttDoc       As Variant
   Dim oKompDoc3D    As KompasAPI7.KompasDocument3D
   Dim oProdDataMgr  As KompasAPI7.IProductDataManager
   Dim oPropKeeper   As KompasAPI7.IPropertyKeeper
   Dim sArrFfn()     As String
   Dim ffnCont       As String
   Dim ffnRef        As String
   Dim fnRef         As String
   Dim i             As Long
   '
   i = 0
   ReDim sArrFfn(0)
   ffnCont = oKompDoc.PathName
   Set oProdDataMgr = oKompDoc
   Set oKompDoc3D = oKompDoc
   Set oPropKeeper = oKompDoc3D
   vAttDocs = ArrayObjects(oProdDataMgr.ObjectAttachedDocuments(oPropKeeper))
   If Not IsEmpty(vAttDocs) Then
      For Each vAttDoc In vAttDocs
         ffnRef = vAttDoc
         fnRef = FileNameWithExtention(ffnRef)
         If StrComp(ffnRef, ffnCont, vbTextCompare) = 0 Then GoTo NEXT_ATTACHED
         If bOnlyDraw Then
            If Not UCase(fnRef) Like UCase(MASK_CDW) Then GoTo NEXT_ATTACHED
         End If
         ReDim Preserve sArrFfn(i)
         sArrFfn(i) = ffnRef
         i = i + 1
NEXT_ATTACHED:
      Next
   End If
   GetAttachedDocuments = sArrFfn
End Function

Замечу, что связанными могут быть не только чертежи.
КОМПАС позволяет "связывать" и другие файлы. Хоть и ругается при их связывании. А иногда и не связывает, бывает.

[lavgirb]

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

        ReDim attached_documents(0 To -1) ' Явно создаём пустой инициализированный массив


Михаил88, с (0 To -1) не сталкивался. Не подскажете, где можно про это почитать?

[Михаил88]

Михаил88, с (0 To -1) не сталкивался. Не подскажете, где можно про это почитать?

Если что-то не получается (VBA использую редко в основном пишу на python), ищу в поисковике, документации и спрашиваю у ИИ.
В данном случае закинул в чат с ИИ код из сообщения #56, обозначил задачу, что нужно доработать.

Можно еще так сделать: attached_documents = Split(vbNullString, ",") вместо ReDim attached_documents(0 To -1).

Ответ ИИ.
Кратко о ReDim attached_documents(0 To -1):
Оператор ReDim в VB/VBA изменяет размер динамического массива во время выполнения программы.
Массив attached_documents — объект, размер которого корректируется.
Границы (0 To -1) задают:
нижнюю границу индекса — 0;
верхнюю границу индекса — -1 (меньше нижней).
Результат: массив становится нулевой длины (0 элементов), поскольку:
число элементов=верхняя граница−нижняя граница+1=−1−0+1=0
Последствия:
все данные в массиве утрачиваются;
память, выделенная под элементы, освобождается;
переменная массива сохраняется, но остаётся пустой.
Ключевое условие: массив должен быть объявлен как динамический (без фиксированного размера при создании).
Отсутствие Preserve означает, что сохранение данных не предусмотрено.
Итог: строка быстро очищает динамический массив, приводя его к состоянию «пусто, 0 элементов».

[p3452]

память, выделенная под элементы, освобождается;

?
Вызывает большие сомнения!
1. В VBA нет "сборщика мусора".
2. В VBA, так же как и С++, пользователь должен сам заботится об "освобождении памяти".
3. Для VBA, так же как и С++, "утечка памяти" - "больная тема"...

[lavgirb]

Да, в приведенном коде есть функция, одна из востребованных 
После нее можно работать с возвращаемыми данными как с массивом.
Не заботясь о том, массив возвращается или отдельный объект.
Здесь, правда, это уже обсуждалось.
Так, до кучи.

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

'===============================================================================
Private Function ArrayObjects(ByVal vObjects As Variant) As Variant
  ArrayObjects = Empty
  If IsEmpty(vObjects) Then Exit Function
  If IsArray(vObjects) Then
      ArrayObjects = vObjects
  Else
      ArrayObjects = Array(vObjects)
  End If
End Function

[Gruden]

Обычная проверка на существование массива и что он из себя представляет, т.к. от этого может зависеть, как дальше работать с ним.

[Валерич]

Отсутствие связанных чертежей - штатная ситуация для КОМПАС.
По идее, программа не должна выдавать ошибку на штатных ситуациях.
Тут над использовать переменную типа Variant. Как и во многих других местах API КОМПАС.
У меня вот такая рабочая функция.

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

'===============================================================================
'
' Выявление связанных чертежей
'
Private Function GetAttachedDocuments(ByRef oKompDoc As KompasAPI7.KompasDocument, _
                        Optional ByVal bOnlyDraw As Boolean = True) As String()
   Dim vAttDocs      As Variant
   Dim vAttDoc       As Variant
   Dim oKompDoc3D    As KompasAPI7.KompasDocument3D
   Dim oProdDataMgr  As KompasAPI7.IProductDataManager
   Dim oPropKeeper   As KompasAPI7.IPropertyKeeper
   Dim sArrFfn()     As String
   Dim ffnCont       As String
   Dim ffnRef        As String
   Dim fnRef         As String
   Dim i             As Long
   '
   i = 0
   ReDim sArrFfn(0)
   ffnCont = oKompDoc.PathName
   Set oProdDataMgr = oKompDoc
   Set oKompDoc3D = oKompDoc
   Set oPropKeeper = oKompDoc3D
   vAttDocs = ArrayObjects(oProdDataMgr.ObjectAttachedDocuments(oPropKeeper))
   If Not IsEmpty(vAttDocs) Then
      For Each vAttDoc In vAttDocs
         ffnRef = vAttDoc
         fnRef = FileNameWithExtention(ffnRef)
         If StrComp(ffnRef, ffnCont, vbTextCompare) = 0 Then GoTo NEXT_ATTACHED
         If bOnlyDraw Then
            If Not UCase(fnRef) Like UCase(MASK_CDW) Then GoTo NEXT_ATTACHED
         End If
         ReDim Preserve sArrFfn(i)
         sArrFfn(i) = ffnRef
         i = i + 1
NEXT_ATTACHED:
      Next
   End If
   GetAttachedDocuments = sArrFfn
End Function

Замечу, что связанными могут быть не только чертежи.
КОМПАС позволяет "связывать" и другие файлы. Хоть и ругается при их связывании. А иногда и не связывает, бывает.

Добрый день!
Пожалуйста, уточните описание функции
FileNameWithExtention(... As Variant).

[Валерич]

На рабочем месте, что-либо установить практически невозможно.
А, Офис есть везде и всегда, поэтому - VBA.

[lavgirb]

Добрый день!
Пожалуйста, уточните описание функции
FileNameWithExtention(... As Variant).

функция из полного пути возвращает имя файла с расширением.
В данном случае можно было сравнивать и полный путь. Но так почему-то было сделано, а переделывать не стал.

А вообще, цель была показать, что ошибка в программе не возникает, если связанных документов нет.

[Валерич]

Добрый день!
Пожалуйста, подскажите,
как можно программно сформировать на сборочном чертеже обозначения позиций,
с указанием связанных (синих) номеров из спецификации чертежа, созданной вручную (в данном случае программно)?
Спецификация чертежа не связана со сборками и деталями.
Можно ли связать обозначения позиций с геометрией вида (активного) или хотя бы вывести позиции на лист?

[lavgirb]

Можно программно внести Ваши номера позиций в свойство "Позиция" компонентов.
Потом эти номера в сборочном чертеже будут синими на полках линий-выносок для номеров позиций.
При определенных условиях. У меня так работает Браком.

[Валерич]

В свойствах детали сборки нет позиции.
Для каждой нужно использовать IPropertyMng (SetProperty),
IPropertyKeeper, IProperty?
Так я понимаю?
А, определенные условия какие? Может, какой-то пример есть?

[lavgirb]

В свойствах детали сборки нет позиции.
Для каждой нужно использовать IPropertyMng (SetProperty),
IPropertyKeeper, IProperty?
Так я понимаю?
А, определенные условия какие? Может, какой-то пример есть?

Я Вам сделал хорошую подсказку.
Дерзайте, а то не интересно будет!

[Валерич]

Может подскажите, как подсветить (как бы выбрать мышкой) строку в спецификации чертежа?

[Валерич]

Я Вам сделал хорошую подсказку.
Дерзайте, а то не интересно будет!

Нет, ничего не получается...
Прошу помочь. Каким методом Получить/Записать ПОЗИЦИЮ ЭЛЕМЕНТА В СБОРКЕ.

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

Set objKomPropsMng7 = objKomApp7 ' Менеджер СВОЙСТВ
Set objKomPropsKeeper7 = objKomPart7 'Интерфейс Запроса СВОЙСТВ



Dim objKomApp7 As KompasAPI7.IApplication
Dim objKomDoc7 As KompasAPI7.IKompasDocument

'Интерфейс документа-модели
Dim objKomDoc7_3D As KompasAPI7.IKompasDocument3D
Dim objKomPart7 As KompasAPI7.IPart7 ' было .part7
Dim objKomItemPart7 As KompasAPI7.IPart7

Dim objKomPropsKeeper7 As KompasAPI7.IPropertyKeeper 'Интерфейс получения/редактирования значения свойств.
Dim objKomProp7 As KompasAPI7.IProperty 'Интерфейс «свойства». Позволяет задавать параметры свойства. ОДНО СВОЙСТВО

Set objKomDoc7_3D = objKomApp7.ActiveDocument
Set objKomPart7 = objKomDoc7_3D.TopPart

Set objKomPropsMng7 = objKomApp7 ' Менеджер СВОЙСТВ
Set objKomPropsKeeper7 = objKomPart7 'Интерфейс Запроса СВОЙСТВ

'Количество Компонентов в СБОРКЕ
iCountAssem = objKomPart7.Parts.Count

'ЗАПИСАТЬ НОМЕР ПОЗИЦИИ БАЗОВОГО ОБЪЕКТА СПЕЦИФИКАЦИИ В КОМПОНЕНТ СБОРКИ
For iAssem = 0 To iCountAssem - 1

Set objKomItemPart7 = objKomPart7.Parts.Item(iAssem)

'Получение одного свойств (15 - ПОЗИЦИЯ)
Set objKomProp7 = objKomPropsMng7.GetProperty(objKomItemPart7, 15#) '# - Тип Double,  - ПОЗИЦИЯ

'objKomProp7 = Nothing НЕ ПОЛУЧАЕТ УКАЗАННОЕ СВОЙСТВО
'Каким методом Получить/Записать ПОЗИЦИЮ ЭЛЕМЕНТА В СБОРКЕ


'Чтение одного свойств (15 - ПОЗИЦИЯ) в vKomPropVal
bKomPropsKeeper7Return = objKomPropsKeeper7.GetPropertyValue(objKomProp7, vKomPropVal, True, True)


'Запись одного свойств (15 - ПОЗИЦИЯ)
bKomPropsKeeper7Return = objKomPropsKeeper7.SetPropertyValue(objKomProp7, sSpecPos, True)

objKomPart7.Parts.Item(iAssem).Update

Next iAssem 'For iAssem = 0 To iCountAssem - 1


[Михаил88]

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

for part in parts_ex:
    property_keeper = kompas_api7_module.IPropertyKeeper(part)
    property_ = property_mng.GetProperty(VARIANT(VT_EMPTY, None), 15.0)
    print(property_keeper.GetPropertyValue(property_, '', True))
    print(property_keeper.SetPropertyValue(property_, 1001, True))


[Валерич]

Спасибо!
А, что значит 1001 и
(VT_EMPTY, None)

[Валерич]

Где же это все написано?!
Перерыл весь SDK...

[Михаил88]

1001 это просто номер позиции

(VT_EMPTY, None) в VBA это скорее всего Empty

[Валерич]

Работает!
ОТ СПАСИБО!

For iAssem = 0 To iCountAssem - 1

Set objKomItemPart7 = objKomPart7.Parts.Item(iAssem)

Set objKomPropsKeeper7 = objKomItemPart7 'Интерфейс Запроса СВОЙСТВ ВОТ ЭТО НАДО БЫЛО В ЦИКЛ ПОСТАВИТЬ и ОТ ЭЛЕМЕНТА

'Получение одного свойств (15 - ПОЗИЦИЯ) Empty - ТЕКУЩИЙ ДОКУМЕНТ
Set objKomProp7 = objKomPropsMng7.GetProperty(Empty, 15#) '# - Тип Double,  - ПОЗИЦИЯ

'Чтение одного свойств (15 - ПОЗИЦИЯ) в vKomPropVal
bKomPropsKeeper7Return = objKomPropsKeeper7.GetPropertyValue(objKomProp7, vKomPropVal, True, True)


'Запись одного свойств (15 - ПОЗИЦИЯ)
bKomPropsKeeper7Return = objKomPropsKeeper7.SetPropertyValue(objKomProp7, sSpecPos, True)

objKomPart7.Parts.Item(iAssem).Update

Next iAssem 'For iAssem = 0 To iCountAssem - 1