Свойства модели автоматом копировать в свойства чертежа, PDF, xls

[VOleg 228]

Всем добрый день.

Хочу добиться переноса свойств модели (Обозначение, Наименование, Автор) в свойства чертежа, далее в свойства PDF, и спецификации XLS. Минимально нужно перенести Наименование.

На скрине для 1-ой сборки это я вручную заполнил, что смог.

1 Сама модель - для такого автомата надо уметь связывать свойства Тема и Заголовок вкладки суммарной информации с Обозначением и Наименованием вкладки 00 конфигурации. Пока не знаю как это сделать и возможно ли.

2 Чертеж - соответственно, Тема и Заголовок модели должны быть как-то связаны с Тема и Заголовок чертжеа?

3 PDF, созданный с чертежа, вообще не имеет нужных свойств.

4 Спецификация при сохранении в XLS даже имени файла не предлагает.

Что делать?

[VOleg 228]

По чертежу добавлю рисуночек. Вкладка Суммарная информация - это вкладка чертежа. Возможно?

 

[DuS 325]

Из свойств детали можно перенести любое свойство на чертеж, эксель. Насчёт пдф не знаю. Непонятно первый скрин откуда. 

[VOleg 228]

1 час назад, DuS сказал:

Из свойств детали можно перенести любое свойство на чертеж, эксель. Насчёт пдф не знаю. Непонятно первый скрин откуда. 

Уточняю. Мне нужно перенести "Свойства файла модели" в "Свойства файла чертежа". Касательно Солида - частный случай - свойства Тема и Заголовок вкладки Суммарная информация модели в те же свойства вкладки Суммарная информация чертежа. Цель - видеть их в проводнике Виндоус и иметь возможность сортировки по этим свойствам. Первый скрин - проводник.

Повторяю скрин с заголовками. Здесь свойства заполнены ручками.

[Snake 60 689]

@VOleg Олег, макрос должен обработать файлы в папке или в открытой сборке?

[VOleg 228]

8 минут назад, Snake 60 сказал:

@VOleg Олег, макрос должен обработать файлы в папке или в открытой сборке?

1 Я создаю новую модель. Заполняю на вкладке Конфигурация Обозначение и Наименование. На вкладке Настройка из списка (через Таб-билдер) выбираю себя. Все они должны автоматом переписаться на вкладку Суммарная информация, например, по событию "Сохранить".

2 Закончив и сохранив модель я жму "Создать чертеж". При вставке в чертеж модели или при сохранении чертежа все эти свойства  должны переписаться в Суммарную информацию уже чертежа.

3 Оформив и сохранив чертеж я жму Сохранить как PDF. При этом опять эти свойства должны переписаться в свойства файла чертежа в формате PDF.

4 Если модель - сборка, то на чертеже я размещаю спецификацию Эксель и жму кнопку на поле спецификации Сохранить как XLS. И опять мне надо, чтобы файл Эксель имел эти же свойства файла (Тема, Название, Автор). Здесь имя файла не формируется, но я его копирую в проводнике с модели и вставляю. Но можно, заодно и автоматом заполнять.

Для чего все это:

В проводнике мне нужна сортировка

1- по Обозначению. 

2 - по Наименованию

3 - по Автору

Во всех случаях, найдя нужную модель я буду иметь вместе все файлы этой модели. 

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

На последних испытаниях изделия в цеху (я вручную подготовился - благо была маленькая сборка) и мне самому было приятно почти мгновенно отвечать на вопросы и по размерам и по позициям.

Ясен пень, что поиск заимствованных моделей упростился в разы.

В общем захотелось иметь эту инфу в каждой папке.

[VOleg 228]

Пункты 1 и 2 думаю изложить по -другому:

1 Я создаю новую модель. Заполняю на вкладке Конфигурация Обозначение и Наименование. На вкладке Настройка из списка (через Таб-билдер) выбираю себя и папку, в которую будет все это складываться.

2 Закончив и сохранив модель я жму кнопку макроса "Создать чертеж". При этом все эти свойства переписываются в Суммарную информацию модели и чертежа. Дополнительно в модели создается виртуальная деталь "СП", в которую записываются все свойства спецификации: Обозначение, Наименование, Автор,  Перв. применение спецификации, № изменения, № извещения, имя папки.

Пункт 3 надо то же подправить:

3 Для сборочного чертежа я жму кнопку макроса "Создать спецификацию". При этом за полем чертежа вставляется спецификация, сразу формируется имя файла и подставляется имя папки, спецификация сохраняется с расширением XLS. Можно здесь же сохранить и сам чертеж, и PDF, благо имена одинаковые и уже сформированы. Соответственно в свойства файла PDF записываем Обозначение Наименование Автор.

4 Ну а для чертежа детали кнопка макроса "Сохранить" - аналогично п.3 но без спецификации.

Изменено 9 марта пользователем VOleg

[VOleg 228]

Переписать Автора, Обозначение, Наименование получилось, но с текущей конфигурации. Надо бы перейти в конфигурацию 00.

Дополнительно с вкладки Настройки надо списать имя папки, добавив диск "D" и сформировать имя файла =D:\Имя папки\Обозначение Наименование, проверить сохранен ли файл модели и если не сохранен, то сохранить. Далее проверить есть ли в папке чертеж, если есть, то открыть, если нет, то создать, заполнить вкладку Сумм. информ. чертежа, сохранить чертеж и закончить работу макроса - дальше я буду работать с чертежом. Вроде так?
'Option Explicit
Option Base 0
Dim swApp As Object

Sub sumprop()
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swConfigMgr             As SldWorks.ConfigurationManager
    Dim swConfig                As SldWorks.Configuration
    Dim swCustPropMgr           As SldWorks.CustomPropertyManager
    Dim cpm                     As CustomPropertyManager
    Dim mde                     As ModelDocExtension
    Dim vPropNames              As Variant
    Dim vConfName               As Variant
    Dim vConfParam              As Variant
    Dim vConfValue              As Variant
    Dim i                       As Long
    Dim j                       As Long
    Dim n                       As Integer
    Dim nprops                  As Integer
    Dim valOut                  As String
    Dim resolvedValOut          As String
    Dim custPropType            As Long
    Dim dcn                     As Variant
    Dim naim                    As Variant
 
    dcn = Null
    naim = Null
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    ' Начальные проверки
    If swModel Is Nothing Then
      MsgBox "Откройте документ", , "Ничего не открыто"
      Exit Sub
    End If
    
    Set swConfigMgr = swModel.ConfigurationManager
    Set swConfig = swConfigMgr.ActiveConfiguration
    Set swCustPropMgr = swConfig.CustomPropertyManager
    Set mde = swModel.Extension()
    Set cpm = mde.CustomPropertyManager("")
    nprops = swCustPropMgr.Count
    vPropNames = swCustPropMgr.GetNames
        
    For j = 0 To nprops - 1
      swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
      If vPropNames(j) = "Обозначение" Then dcn = resolvedValOut
      If vPropNames(j) = "Наименование" Then naim = resolvedValOut
    Next j
    If IsNull(dcn) Then
      MsgBox "Свойство " + VBA.Chr(34) + "Обозначение" + VBA.Chr(34) + " не найдено в текущей конфигурации"
    Else
      swModel.SummaryInfo(swSumInfoSubject) = dcn
    End If
    If IsNull(naim) Then
      MsgBox "Свойство " + VBA.Chr(34) + "Наименование" + VBA.Chr(34) + " не найдено в текущей конфигурации"
    Else
      swModel.SummaryInfo(swSumInfoTitle) = naim
    End If

    swModel.SummaryInfo(swSumInfoAuthor) = cpm.Get("Разраб.")

End Sub
 

Забыл про виртуальную деталь со свойствами спецификации

[VOleg 228]

    ' имя папки - желательно проверить наличие самого свойства Система. Как - не знаю.
    sist = cpm.Get("Система")
    If IsNull(sist) Then
      MsgBox "Свойство " + VBA.Chr(34) + "Система" + VBA.Chr(34) + " не найдено"
    End If
    
    ' имя файла
    naimFile = "D:\" + sist + "\" + dcn + " " + naim
    MsgBox naimFile

[VOleg 228]

Запустил макрос при открытом чертеже.

Пометил звездочками строку, где происходит остановка.
'Option Explicit
Option Base 0
Dim swApp As Object

Sub sumprop()
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swConfigMgr             As SldWorks.ConfigurationManager
    Dim swConfig                As SldWorks.Configuration
    Dim swCustPropMgr           As SldWorks.CustomPropertyManager
    Dim cpm                     As CustomPropertyManager
    Dim mde                     As ModelDocExtension
    Dim vPropNames              As Variant
    Dim vConfName               As Variant
    Dim vConfParam              As Variant
    Dim vConfValue              As Variant
    Dim i                       As Long
    Dim j                       As Long
    Dim n                       As Integer
    Dim nprops                  As Integer
    Dim valOut                  As String
    Dim resolvedValOut          As String
    Dim custPropType            As Long
    Dim dcn                     As Variant
    'naim Наименование
    Dim naim                    As Variant
    'naimFile имя файла
    Dim naimFile                As Variant
    'sist имя папки
    Dim sist                    As Variant

 
    dcn = Null
    naim = Null
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    ' Начальные проверки
    If swModel Is Nothing Then
      MsgBox "Откройте документ", , "Ничего не открыто"
      Exit Sub
    End If
    
    Set swConfigMgr = swModel.ConfigurationManager
    Set swConfig = swConfigMgr.ActiveConfiguration
 *****  выдает ошибку в строке: Set swCustPropMgr = swConfig.CustomPropertyManager
    Set mde = swModel.Extension()
    Set cpm = mde.CustomPropertyManager("")
    nprops = swCustPropMgr.Count
    vPropNames = swCustPropMgr.GetNames
        
    For j = 0 To nprops - 1
      swCustPropMgr.Get2 vPropNames(j), valOut, resolvedValOut
      If vPropNames(j) = "Обозначение" Then dcn = resolvedValOut
      If vPropNames(j) = "Наименование" Then naim = resolvedValOut
    Next j
    If IsNull(dcn) Then
      MsgBox "Свойство " + "Обозначение" + " не заполнено в текущей конфигурации"
    Else
      swModel.SummaryInfo(swSumInfoSubject) = dcn
    End If
    If IsNull(naim) Then
      MsgBox "Свойство " + "Наименование" + " не заполнено в текущей конфигурации"
    Else
      swModel.SummaryInfo(swSumInfoTitle) = naim
    End If

    swModel.SummaryInfo(swSumInfoAuthor) = cpm.Get("Разраб.")
    ' имя папки желательно проверить наличие самого свойства Система.
    sist = cpm.Get("Система")
    If IsNull(sist) Then
      MsgBox "Свойство " + "Система" + VBA.Chr(34) + " не заполнено"
    End If
    
    ' имя файла
    naimFile = "D:\" + sist + "\" + dcn + " " + naim
    MsgBox naimFile

End Sub

[Kelny 1 239]

4 часа назад, VOleg сказал:

...

Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

...

Set swConfigMgr = swModel.ConfigurationManager
    Set swConfig = swConfigMgr.ActiveConfiguration
 *****  выдает ошибку в строке: Set swCustPropMgr = swConfig.CustomPropertyManager

...

Может что не понял, но как-то заморочено:

Цитата

 ...

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc
Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.CustomPropertyManager

...

 

https://help.solidworks.com/2020/english/api/sldworksapi/Get_Custom_Properties_for_Configuration_Example_VB.htm

 

Изменено 11 марта пользователем Kelny

[DuS 325]

Коллеги, чем дело закончилось?
Я обнаружил что без бубна в проводнике видно свойство description, но проводник при этом работает медленно.

[VOleg 228]

5 часов назад, DuS сказал:

Коллеги, чем дело закончилось?
Я обнаружил что без бубна в проводнике видно свойство description, но проводник при этом работает медленно.

Проводник как быстро работал, так и работает. Мне нужно отдельно свойство Наименование для сортировки по нему. Соответственно, все типы файлов одной модели при сортировке по наименованию должны оказаться снова рядом - и СП и чертеж и модель.

С написанием макроса для этого у меня проблемы. Жду, может кто поможет.