Hi All,
I would like to make a macro for 2 things.
1: I would like to save my drawings into PDF and DWG. This is the easy part, the more complex part that I would like to insert some static characters into the file name and a dynamic part, which should come from one of the custom properties fields of the model shows on the drawings. Like this: Original file name: pn.sldprt or pn.sldasm and pn.slddrw, created files: "pn REV A.pdf" and "pn REV A.dwg". The "A" should come from the "Revision" field of the custom properties of the PART or ASSEMBLY, which is shown on the drawing.
If I using the
- 'Get Revision
- Revision = swModel.CustomInfo("Revision")
syntax, it gives me the Revision from the custom properties field of the drawing file, not from the inserted model. Somehow I need to manage to receive this information from the part or assembly file.
2: The other thing is to save these files into a sub-folder. File structure like this:
...(static part)\(dynamic, job-specific part)\Drawings(static obviously)
The SolidWorks files could be in the "Drawings" folder, or anywhere else in sub-folders under the "Drawings". I need to save the pdf and dwg files into the ...(static part)\(dynamic, job-specific part)\Drawings\DWG Folder.
Because of the job-specific, dynamic part, it can't be hard-wired, and because of the possible dynamic structure under the "Drawings" it can't be a "describing path (go up x levels, go into the \DWG". My idea is to investigate the folder path, use everything from the start until the fixed "\Drawings" character string and add the "\DWG" string to the location.
Any ideas?
This is my latest code, I stopped at the revision infor, and not even started the location part... BTW, I'm quite bad in programming...
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swView As SldWorks.View
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim filename As String
Dim swCi As String
Dim rev As String
Dim lErrors As Long
Dim lWarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swView = swModel.GetFirstView
Set swCi = swView.ReferencedDocument 'Stops here with "object required...
If swModel Is Nothing Then
MsgBox "No current document", vbCritical
End
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "This Macro only works on Drawings", vbCritical
End
End If
Set swModelDocExt = swModel.Extension
Set swExportData = swApp.GetExportFileData(swExportPDFData)
filename = swModel.GetPathName
If filename = "" Then
MsgBox "Please save the file first and try again", vbCritical
End
End If
'Get Revision
rev = swCi.CustomInfo("Revision")
'Add revision info and create dwg file
filename = Strings.Left(filename, Len(filename) - 7) & " REV " & rev & ".dwg"
boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)
'Create pdf file
filename = Strings.Left(filename, Len(filename) - 3) & "PDF"
boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)
If boolstatus Then
MsgBox "Save as DWG and PDF with revision successful" & vbNewLine & filename
Else
MsgBox "Save as failed, Error code:" & lErrors
End If
End Sub