Макрос для внесения имени файла в свойства конфигурации

[Neodim 0]

Всем доброго времени суток!

 

Подскажите, как сделать?

 

Именую файлы следующим способом:

 

12345.00.000_Сборка 1

 

Нужно, чтобы 12345 заносилось в поле "Номер заказа" в окне "Конфигурация" свойств файла, 12345.00.000 - в поле "Обозначение" того же окна, Сборка 1 - в поле "Наименование"

 

То есть извлекалась информация из имени файла и автоматически вносилась в поля основной надписи (3 поля) через атрибуты.

 

Нашел такой макрос. Но он добавляет информацию во вкладку "Настройка", а мне надо во вкладку "Конфигурация"

 

 

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim errors             As Long
Dim warnings           As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swModelDocExt = swModel.Extension
    Set swCustProp = swModelDocExt.CustomPropertyManager("")

    bool = swCustProp.Add3("Обозначение", swCustomInfoText, Left(swModel.GetTitle, InStr(swModel.GetTitle, "_") - 1), 2)
    bool = swCustProp.Add3("Наименование", swCustomInfoText, Right(swModel.GetTitle, Len(swModel.GetTitle) - InStrRev(swModel.GetTitle, "_")), 2)
    bool = swModel.Save3(13, errors, warnings)

End Sub

 

 

Спасибо!
 

[Leon 433]

Set swCustProp = swModelDocExt.CustomPropertyManager("Имя конфигурации")

[Neodim 0]

Помогло. Спасибо!

Номер заказа и Обозначение вносит верно, а вот Наименование с расширением файла. Как убрать точку и расширение файла из строчки, подчеркнутой красным?

 

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim errors             As Long
Dim warnings           As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swModelDocExt = swModel.Extension
    Set swCustProp = swModelDocExt.CustomPropertyManager("По умолчанию")

    bool = swCustProp.Add3("Номер заказа", swCustomInfoText, Left(swModel.GetTitle, InStr(swModel.GetTitle, ".") - 1), 2)
    bool = swCustProp.Add3("Обозначение", swCustomInfoText, Left(swModel.GetTitle, InStr(swModel.GetTitle, "_") - 1), 2)
    bool = swCustProp.Add3("Наименование", swCustomInfoText, Right(swModel.GetTitle, Len(swModel.GetTitle) - InStrRev(swModel.GetTitle, "_")), 2)
    bool = swModel.Save3(13, errors, warnings)

End Sub
 

 

 

[Chuvak 16]

@Neodim Странно, у меня все правильно прописывается , без расширения файла. Теме более метод GetTitle как раз и возвращает только имя файла, без расширения и пути.

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

Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swModelDocExt       As SldWorks.ModelDocExtension
Dim swConfMgr           As SldWorks.ConfigurationManager
Dim swConf              As SldWorks.Configuration
Dim swCustProp          As SldWorks.CustomPropertyManager
Dim bool                As Boolean
Dim errors              As Long
Dim warnings            As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swModelDocExt = swModel.Extension
    Set swConfMgr = swModel.ConfigurationManager
    Set swConf = swConfMgr.ActiveConfiguration
    Set swCustProp = swModelDocExt.CustomPropertyManager(swConf.Name)

    bool = swCustProp.Add3("Номер заказа", swCustomInfoText, Left(swModel.GetTitle, InStr(swModel.GetTitle, ".") - 1), 2)
    bool = swCustProp.Add3("Обозначение", swCustomInfoText, Left(swModel.GetTitle, InStr(swModel.GetTitle, "_") - 1), 2)
    bool = swCustProp.Add3("Наименование", swCustomInfoText, Right(swModel.GetTitle, Len(swModel.GetTitle) - InStrRev(swModel.GetTitle, "_")), 2)
    bool = swModel.Save3(1, errors, warnings)

End Sub
 

Изменено 22 ноября 2023 пользователем Chuvak

[Neodim 0]

Не знаю. 

Ваш код тоже попробовал. Расширение остается все равно. Может есть еще какие-то варианты?

Изменено 22 ноября 2023 пользователем Neodim

[Chuvak 16]

@Neodim А у Вас какая версия Solidworks ?

47 минут назад, Neodim сказал:

Может есть еще какие-то варианты?

Варианты есть и не один)

Все, понял. У Вас в настройках проводника включена функция "Расширения имен файлов".

 

Если вам не нужна данная функция, то можете просто снять галочку и использовать код. Если же нет, то нужно будет использовать функцию Mid вместо Right

[Chuvak 16]

Протестируете след. код:

 

Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swModelDocExt       As SldWorks.ModelDocExtension
Dim swConfMgr           As SldWorks.ConfigurationManager
Dim swConf              As SldWorks.Configuration
Dim swCustProp          As SldWorks.CustomPropertyManager
Dim bool                As Boolean
Dim errors              As Long
Dim warnings            As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swModelDocExt = swModel.Extension
    Set swConfMgr = swModel.ConfigurationManager
    Set swConf = swConfMgr.ActiveConfiguration
    Set swCustProp = swModelDocExt.CustomPropertyManager(swConf.Name)

    bool = swCustProp.Add3("Номер заказа", swCustomInfoText, Left(swModel.GetTitle, InStr(swModel.GetTitle, ".") - 1), 2)
    bool = swCustProp.Add3("Обозначение", swCustomInfoText, Left(swModel.GetTitle, InStr(swModel.GetTitle, "_") - 1), 2)
    bool = swCustProp.Add3("Наименование", swCustomInfoText, Mid(swModel.GetTitle, InStr(swModel.GetTitle, "_") + 1, InStrRev(swModel.GetTitle, ".") - InStr(swModel.GetTitle, "_") - 1), 2)
    bool = swModel.Save3(1, errors, warnings)

End Sub

Изменено 22 ноября 2023 пользователем Chuvak

[Neodim 0]

Класс! Супер!

 

Работает! Сэкономит мне много времени на работе!

 

Вы мастер!

[Chuvak 16]

Да не за что)

[DANGER1979 10]

Я сделал так и  прописал комментарии, т.к. первый раз для солида пишу макрос, точнее поправляю чужой. Может кому также будет полезно, кто первый раз читает код на VBA под солид.
 

'-------------------------------------------------- ---
  ' Предварительные условия:
  ' 1. Сохраните данный макрос через 'Инструменты - Макрос - Создани' допустим под именем "Макрос для внесения имени файла в свойства конфигурации".
  ' 2. Откройте деталь в формате Обозначение - Наименование
  ' 3. Откройте данный макрос через 'Инструменты - Макрос - Выполнить'.
  ' 4. Чтобы убедиться откройте окно 'Файл - Свойства - Настройки'.
  '
  ' Постусловия: разделает название файла в формате Обозначение - Наименование и заносит данные в свойства модели.
  '-------------------------------------------------- --

Option Explicit
Dim swApp As SldWorks.SldWorks 'Предоставляет доступ к SOLIDWORKS
Dim swModel As ModelDoc2 'Предоставляет доступ к документам SOLIDWORKS: деталям, сборкам и чертежам.
Dim swModelDocExt As ModelDocExtension 'Разрешает доступ к модели.
Dim swCustProp As CustomPropertyManager  'Получает информацию о настраиваемых свойствах для этой конфигурации
            'As SldWorks.CustomPropertyManager
'Dim swConfMgr           As SldWorks.ConfigurationManager
'объявляем новые переменные
Dim bool As Boolean
Dim errors             As Long
Dim warnings           As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc 'Предоставляет доступ к активным документам
    Set swModelDocExt = swModel.Extension 'Получает объект расширения swModel(ModelDoc2), который также обеспечивает доступ к документу модели.
    Set swCustProp = swModelDocExt.CustomPropertyManager("") 'Получает объект доступа к модели, который также обеспечивает доступ к свойствам для этой конфигурации.
    'Set swConfMgr = swModel.ConfigurationManager 'если будем заносить в свойства конфигурации
    
    bool = swCustProp.Add3("Обозначение", swCustomInfoText, Left(swModel.GetTitle, InStr(swModel.GetTitle, " - ") - 1), 2)
    ' (InStr) Возвращает значение, определяющее положение первого вхождения строки  " - " в полученном названии модели (swModel.GetTitle)
    ' (Left) возвращаем крайние левые символы из строкового выражения с указанием сколько знаков должно быть возвращено уменьшенное на 1
    ' (Add3) добавляем пользовательское свойство в документ конфигурации или модели как текст (swCustomInfoText) в параметр "Обозначение". Всегда 2
    
    bool = swCustProp.Add3("Наименование", swCustomInfoText, Right(swModel.GetTitle, Len(swModel.GetTitle) - InStrRev(swModel.GetTitle, " - ") - 2), 2)
    ' (Len) Возвращает число символов в полученном названии модели (swModel.GetTitle)
    ' (InStrRev) и вычитаем Возвращенное положение вхождения строки " - " в рамках полученного названия модели (swModel.GetTitle) уменьшенное на 2
    ' (Right) возвращаем крайние правые символы из строкового выражения с указанием сколько знаков должно быть возвращено
    ' (Add3) добавляем пользовательское свойство в документ конфигурации или модели как текст (swCustomInfoText) в параметр "Обозначение"
    
    bool = swModel.Save3(13, errors, warnings) ' сохраняем текущий документ Options(13)
End Sub

 

[Maik812 290]

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

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

Вариант есть простой использовать саму файловую систему там есть потоки и они как база данных привязывается к файлу инфу, ее можно заносить автоматом и из нее автоматом заполнять в солид файлы(старые версии солида, нужен плагин под новые) обьем почти не ограничен и копии файло и другие документы в самих файлах..