Solidworks PDF Drawing Macro

[valentin.fer]

Hello Madam, Sir,

I took this macro on the net to save my drawings directly in pdf.
Unfortunately being a beginner in the field, I don't know how to add the path to the record folder of my drawings.

Can someone tell me how to proceed?

Here's the macro I found if it helps, it works but saves PDFs in the same folder as my SW drawings.

Thanks in advance!

Kind regards

---

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

[sbadenis]

Inspired by @Cyril.f.' s answer:

Macro DWG and PDF on the

Hello, we need to change as follows: Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim FeatureData As Object Dim Feature As Object Dim Component As Object Sub main() Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc Path = Part.GetPathName ' file path Path = Mid(Path, InStrRev(Path, "\") + 1) 'Purge the path Path = About("userprofile") & "\Desktop\" & Path Part.SaveAs2 Left(Path, (Len(Path) - 6)) & "PDF", ...

This (untested) code should work

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename =  Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & « pdf »
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

[Cyril.f]

Good evening

In addition to @sbadenis's response, is the recording path fixed or not?
The code offered saves on the desktop.

[valentin.fer]

Hello Cyril,

The path will be in a folder dedicated to the plan in PDF which is different from the one in SW format.
But in time the location will change because I work in folders of 1000 plans and it goes very fast. (folder in a dedicated server)

Also, I'm not sure I understood what I should do in the @sbadenis macro and where to add my path

Thank you very much for your answers.

Kind regards

[sbadenis]

The path was already hard-added (to the desktop)
How do you want to use macro?
Case N°1 file by file the macro asks you or you want to save your file to each file (which can be quickly a headache if 100 files to save)
Case N°2 in a subdirectory of your file (always identical)
Case N°3 (the one I had chosen) on the desktop (If necessary add Maps/ behind Desktop to have a folder on the desktop).

[valentin.fer]

Okay, thanks for the clarification.

I have a PDF drawing folder and inside I have several folders arranged in increments of 1000 pdf plans.

Example:

• 1-1000
• 1001-2000
• 2001-3000

I think I'm going to put the macro button in my toolbar and it will save in the location that I chose and I'll change it afterward.

I just need to replace the path to the office with the one I want if I understand correctly, I'll give it a try.
My current path is like this:
O:\SolidWorks Database\03-PDF Library\18001-19000

Thank you very much Denis for your answer.

Kind regards

[sbadenis]

In this case you change this line:

strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename

By '''
strFilename = "O:\SolidWorks Base\03-PDF Library\18001-19000" & strFilename

Et le jour ou tu aura dépassé tes 1000 tu changes de nouveau cette ligne dans la macro

[valentin.fer]

Unfortunately it doesn't work

[sbadenis]

Indeed error there was a \ missing after 19000, here is the code modified and complete and tested:

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès
strFilename = "O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000\" & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

You must also have the 18001-19000 folder already existing before launching the macro

[valentin.fer]

Oh, yes! Well done

It's perfect, it works!

Thank you very much!

[valentin.fer]

Out of curiosity, would it be complex to automatically find the right file to the macro when I have passed the milestone of the plan numbers?

[sbadenis]

If you find your number in the name of the room, it is quite easy to do.
by adding just below this line:

strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès

You get the 2 1st digits and we change the name of the folder accordingly.
It would add a few lines of code but nothing fancy.
On the other hand, you must also create the file if it does not exist.

[valentin.fer]

Okay, I think I understand the principle.

Currently, as mentioned earlier, I work with folders named exactly like this: (I create them in advance)

17001-18000
18001-19000
19001-20000

I'm going to have to change the name of my folders to make the macro work?

[sbadenis]

No, for me it's possible via macro, but it would add a few lines of code and you have to be sure that the file name of the MEP is also included in the values indicated by the folder (example 18001.slddrw-> folder 18001-19000)
Can you give the exact name of a drawing as an example?
Because the idea would be to retrieve via macro the 1st digit and following these digits to save in the existing directory or to create the folder if we go to the next thousand.

[sbadenis]

Here is the modified code for the automatic creation of the folder name if the MEps are indeed in this form:
18001.slddrw, 19000.slddrw, or 20000.slddrw...

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim FolderName As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès
FolderName = Left(strFilename, Len(strFilename) - 7)
Debug.Print Right(FolderName, Len(FolderName) - 2)
If Right(FolderName, Len(FolderName) - 2) = "000" Then

'Si la MEP se termine par 000 on créer le dossier avec avec comme début de N° FolderName-1
FolderName = (Left(FolderName, Len(FolderName) - 3) - 1) & "001-" & (Left(FolderName, Len(FolderName) - 3)) & "000"
Else

'Si la MEP ne se termine pas par 000 on créer le dossier avec comme début de N° FolderName
FolderName = Left(FolderName, Len(FolderName) - 3) & "001-" & (Left(FolderName, Len(FolderName) - 3) + 1) & "000"
End If
FolderName = "O:\Base SolidWorks\03-Bibliothèque PDF\" & FolderName & "\"

'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(FolderName, vbDirectory + vbHidden) = "" Then
    MkDir FolderName
    End If



strFilename = FolderName & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

[valentin.fer]

Yes, my drawing files are aptly named that.

I was able to do a test and it works perfectly.

Thank you again for your help, it's really nice