Макрос сохранения чертежа в PDF в SOLIDWORKS 2021

[KrisFormage 0]

Приветствую! Нужна помощь в создании редактировании/создании макроса для того, чтобы по горячей клавише - чертеж сохранялся автоматически в формате PDF.
Как назначить клавишу я разобрался (изи ваще).
А вот с макросом проблема.
Записать его легко, но код получается такой, что он создаёт PDF-файл у месте и с названием прописаном в макросе, а не ставит название исходного документа, и не предлагает выбрать место сохранения.
Вот и прошу шарящих в программировании помочь.
З.Ы.: 2 часа мучений с CHATGPT результата не дало (только ошибки плодил).

Исходный код макроса:

 

' ******************************************************************************
' C:\Users\Work\AppData\Local\Temp\swx5688\Macro1.swb - macro recorded on 04/10/25 by Work
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

' Save As
longstatus = Part.SaveAs3("D:\Деталь1.pdf", 0, 2)
End Sub

[Kelny 1,419]

3 часа назад, KrisFormage сказал:

А вот с макросом проблема.
Записать его легко

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

 

3 часа назад, KrisFormage сказал:

Вот и прошу шарящих в программировании помочь.

Рабочие примеры можно взять в справке, например:

https://help.solidworks.com/2010/english/api/sldworksapi/save_file_as_pdf_example_vb.htm

 

Или есть вариант через виртуальный принтер PDFCreator (старая версия 1 - есть в наборе, можете переписать на новую версию виртуального принтера) из набора макросов SWPluse:

https://cccp3d.ru/topic/70748-swplusnet-оформление-конструкторской-документации/

 

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

[KrisFormage 0]

2 часа назад, Kelny сказал:

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

Записаный макрос работает чётко, ровно так как записался. (суть в том что нельзя остановить запись когда открыто другое диалоговое окно - где выбирается путь, имя и формат файла).
По этому любой чертеж сохраненный через данный макрос всегда сохраняет файл лишь в одно место и с одним и тем-же названием.
По сути вся проблема в скудности вот этой строки:
' Save As
longstatus = Part.SaveAs3("D:\Деталь1.pdf", 0, 2)

В идеале её нужно переработать таким образом, чтобы он сохранял сразу в место где находится ИСХОДНЫЙ файл и с тем же названием ИСХОДНОГО файла, но в формате PDF.

[jtok 883]

Я себе написал вот такой: SaveAsPDF | beamclc.ru

Сохраняет pdf в папке и с именем чертежа.

Скрытый текст

Option Explicit
' ******************************************************************************
'jtok@ya.ru; j@jtok.ru
'2022-10-12
'Сохранение чертежа в PDF рядом с файлом чертежа SLDDRW
'Реализованы все проверки
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim longstatus As Long
Dim FullName, FileName, FilePath, FileExt, a As String

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

If Part Is Nothing Then
  swApp.SendMsgToUser2 "Экспорт в PDF возможен только из чертежа!", swMbWarning, swMbOk
  Exit Sub
End If

If Part.GetType <> swDocDRAWING Then ' проверим, это чертеж?
  swApp.SendMsgToUser2 "Это не чертёж!" + vbLf + vbLf + _
                       "Невозможно сохранить в PDF.", swMbWarning, swMbOk
  Exit Sub
End If

FullName = Part.GetPathName() 'полное имя файла чертежа с путем и расширением
If Not isFileExist(FullName) Or FullName = "" Then
  swApp.SendMsgToUser2 "Чертёж ещё не сохранён!" + vbLf + vbLf + _
                       "Невозможно сохранить в PDF.", swMbWarning, swMbOk
  Exit Sub
End If

FileExt = CreateObject("Scripting.FileSystemObject").GetExtensionName(FullName) 'расширение файла
FileName = CreateObject("Scripting.FileSystemObject").GetBaseName(FullName) 'имя файла без расширения
FilePath = Left(FullName, Len(FullName) - Len(FileName) - Len(FileExt) - 1) 'откинем имя файла, расширение и точку

'достанем Наименование и Обозначение
'в разработке....

On Error Resume Next
If isFileExist(FilePath + FileName + ".pdf") Then DeleteFile (FilePath + FileName + ".pdf") 'если старый PDF существует, удалим его
If isFileExist(FilePath + FileName + ".pdf") Then ' если не получилось удалить(((
  swApp.SendMsgToUser2 "Не удалось удалить предыдущий файл PDF!", swMbWarning, swMbOk
  Exit Sub
End If
    
'Прошли все проверки, все ОК, сохраняем в PDF
Part.ClearSelection2 True 'clear selection
Part.ViewZoomtofit2 ' Zoom To Fit

longstatus = Part.SaveAs3(FilePath + FileName + ".pdf", 0, 0)
If longstatus = 0 Then
  If swApp.SendMsgToUser2("Файл """ + FileName + """ сохранен в PDF." + vbLf + vbLf + _
                          "Полный путь: " + FilePath + vbLf + vbLf + _
                          "Открыть папку в проводнике?", swMbInformation, swMbYesNo) = swMbHitYes Then
    On Error Resume Next
    'добавлены куча кавычек для открытия папок, содержащих в пути пробелы
    Shell "explorer /select,""" & FilePath & FileName & ".pdf""", vbMaximizedFocus
  End If
Else
  swApp.SendMsgToUser2 "Файл """ + FileName + """ НЕ сохранен в PDF!" + vbLf + vbLf + _
                       "Что-то пошло не так.", swMbWarning, swMbOk
End If
End Sub
'Функция проверки существования файла
Function isFileExist(ByVal FullName As String) As Boolean
    On Error Resume Next
    isFileExist = Dir(FullName) <> ""
    If Err.Number <> 0 Then isFileExist = False
    On Error GoTo 0
End Function
'Удаление файла
Sub DeleteFile(ByVal FullName As String)
  On Error Resume Next
  If Dir(FullName) <> "" Then
    CreateObject("Scripting.FileSystemObject").DeleteFile FullName, True
  End If
  On Error GoTo 0
End Sub

 

 

6 часов назад, KrisFormage сказал:

2 часа мучений с CHATGPT результата не дало

Угар конечно.

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

Но вот думать, что всякие чатГПТ могут написать что-то стоящее - это веселит. Максимум они могут дернуть код с гитхаба или сорсфорга и т.п. и никогда еще он не работал нормально после прямой вставки в среду программирования.

Edited April 10 by jtok

[Kelny 1,419]

2 часа назад, KrisFormage сказал:

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

А зачем, он это всё равно не записывает и нужно всего лишь заменить записанное Save, на отредактированное, где вы узнаёте имя файла

fileName = swModel.GetPathName

https://help.solidworks.com/2010/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.imodeldoc2~getpathname.html

 

и потом в полученной строке надо избавиться от расширения (заменить его на .PDF), например:

fileName = Replace ( fileName, ".slddrw", ".pdf", , , vbTextCompare)

 

 это имя применяете при сохранении

swModelDocExt.SaveAs filename, 0, 0, swExportPDFData, lErrors, lWarnings

https://help.solidworks.com/2010/english/api/sldworksapi/Save_File_As_PDF_Example_VB.htm

[KrisFormage 0]

16 часов назад, jtok сказал:

Я себе написал вот такой: SaveAsPDF | beamclc.ru

ВОТ ЭТО ТО ЧТО НУЖНО!!!!! СПАСИБО ДРУЖИЩЕ)))
 

[Fedorly 23]

 

[AlexPar 1]

Вот еще пара макросов: один сохраняет все открытые чертежи в каталог pdf, который надо предварительно создать в каталоге проекта, другой вообще все чертежи в каталоге проекта - для этого в каталоге проекта надо создать папку "макросы" и положить его туда. Делал на 2022 солиде, если другая версия - просто перещелкните ссылки (Tools - References), помеченные MISSING на свои. В шапке макросов подробно разжевано, как их запускать.
PS:
когда сделал, узнал, что вообще то это делается через SolidWorks Task Scheduler. Изобрел велосипед получается.