Jump to content

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


Neodim

Recommended Posts

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

 

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

 

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

 

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

 

 

Спасибо!
 

Link to post
Share on other sites


UnPinned posts

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

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

 

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
 

 

 

Link to post
Share on other sites

@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
 

Edited by Chuvak
Link to post
Share on other sites

Не знаю. 

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

Снимок.PNG

Edited by Neodim
Link to post
Share on other sites

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

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

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

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

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

Безымянный.png

 

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

Link to post
Share on other sites

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

 

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

Edited by Chuvak
  • Нравится 2
Link to post
Share on other sites
  • 2 months later...
DANGER1979

Я сделал так и  прописал комментарии, т.к. первый раз для солида пишу макрос, точнее поправляю чужой. Может кому также будет полезно, кто первый раз читает код на 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

 

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Recently Browsing   0 members

    No registered users viewing this page.




  • Сообщения

    • Snake 60
      Странно, на данный момент для 2024 версии актуальный SP1. Вы из будущего? :)
    • KorovnikovAV
    • Ветерок
      Погасить слой SURFACES, сохранить состояние видимости.
    • AlexVv
      Возможно ввести новые данные есть. Но раньше расчет усилия происходил автоматически.
    • Guhl
      Не. Датчика на шпинделе нету. Но если поставить его, то резьбу ЧПУ должно резать даже если рукой шпиндель крутить.
    • Genius123
      Доброго времени суток, стал с недавних пор пользователем этой чудо программы. Проблема такова, при запуске УП (Сделана в SolidCam), при выполнении первого перехода все работает замечательно, но когда станок подъезжает к следующему переходу обработки , то он начинает обрабатывать деталь в воздухе, пока не нажмешь кнопку "Паузы", потом вновь нажимаем старт появляется окно "preperational positioning" и нажимаем ок, то станок отпускается на нужную высоту к заготовке и начинает обрабатывать, если не нажимать кнопку паузы, то станок все последующие переходы кроме первого орабатывает в воздухе
    • Viktor2004
    • Fixedes
      А во время нарезки резьбы? Такого к сожалению тоже не встречал.   Local Var, Mach variables но я с ними не работал, поэтому не подскажу
    • Salmon
    • meganom
      Может кто подскажет как на чертеже отключить видимость резьбы, чтоб было видно только отверстие, но не контур резьбы. Именно локально для определенного чертежа, а не вообще глобально отключить ее отображение . Просто есть детали на которые делаются DXF контур и отправляется для подготовки ЧПУ программы обработки, и вот этот контур резьбы сильно напрягает. Хотелось бы как то отключать его видимость 
×
×
  • Create New...