Hello
I'm looking for a macro (or a piece of VBA program) that since a SolidWorks drawing would do the following:
- PDF saving of sheets with names starting with "Plan_"
- DWG (R12 version) recording of sheets that starts with "P"
Plan starts with P, right?
Oki, I'm going out...; -)
1 Like
Good remark @max59 , so rather:
Saving in DWG (R12 version) of sheets with the "PXX" syntax
XX being 2 digits
Is it appropriate to export each PXX page into a separate file per page?
1 Like
@MaD:
each PXX page must be a separate file.
On each of these pages is a representation of a plasma cutting body.
I would like to give as file name: MEP FILE NAME-SHEET NAME
As for the PDF saving of the "Plan_" sheets, ideally all the sheets should be grouped together in the same PDF.
For PDF file name: MEP-Description file name (custom property in the part file)
Okay so I have this code to copy
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim Filename As String
Dim lErrors As Long
Dim lWarnings As Long
Dim strSheetName() As String
Dim varSheetName As Variant
'
Dim swDraw As SldWorks.DrawingDoc
Dim vSheetNames As Variant
'
Dim Part As Object
Dim longstatus As Long, longwarnings As Long
Dim File As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' ajout controle du bon fichier
If Part Is Nothing Then
MsgBox "Aucun fichier n'est actuellement ouvert."
Exit Sub ' If no model is currently loaded, then exit
End If
' Determine the document type. If the document is a drawing, then send a message to the user.
If (Part.GetType <> 3) Then '1Part 2Assembly 3Document
MsgBox "Cette macro ne s'applique que sur une mise en plan"
Exit Sub
End If
File = Part.GetPathName
If File = "" Then
MsgBox "Cette macro necessite que le fichier soit préalablement enregistré"
Exit Sub
End If
Dim Filepath As String
Dim Filename As String
Filepath = Left(File, InStrRev(File, "\"))
Filename = Mid(File, Len(Filepath) + 1, Len(File) - (7 + Len(Filepath)))
Set swModelDocExt = Part.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swDraw = Part
vSheetNames = swDraw.GetSheetNames
Dim i As Long
Dim j As Long
j = 0
ReDim strSheetName(UBound(vSheetNames))
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
strSheetName(j) = vSheetNames(i)
j = j + 1
End If
Next
varSheetName = strSheetName
If swExportPDFData Is Nothing Then MsgBox "Nothing"
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, varSheetName)
swExportPDFData.ViewPdfAfterSaving = True
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
'DWG
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat_e.swDxfFormat_R12)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfSeparateSheets)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, 0)
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, 1)
longstatus = Part.SaveAs3(Filepath & "\" & Filename & ".DWG", 0, 0)
For i = 0 To UBound(vSheetNames)
If InStr(vSheetNames(i), "Plan") <> 0 Then
Kill Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG"
End If
Next
End Sub
Try it first on a copy of a plan, you never know and tell me if it fits
3 Likes
Small addition to rename DWGs
If InStr(vSheetNames(i), "Plan") <> 0 Then
Kill Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG"
Else
Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
Name Filepath & "\" & Format(i, String(2, "0")) & "_" & Filename & ".DWG" As Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
End If
I'll let you put it back in the previous code:)
3 Likes
and for the name of the PDF
Dim swCustProp As CustomPropertyManager
Set swCustProp = swModelDocExt.CustomPropertyManager("")
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & "-" & swCustProp.Get("LBM_REV") & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
where LBM_REV is the name of your property:)
Keep us informed
3 Likes
I have an error in the execution of the MACRO:
The result is as follows:
The "description" property does not appear in the PDF file name
for DWGs, (I think it's the result of the error), I'd like to show the names of the sheets (P01, etc.....) at the end.
capture-2.jpg
2 Likes
Indeed, same mistake on your new macro while on the 1st no problems
I see what crashes during my tests it couldn't rename if the file existed so I deleted it but if it doesn't exist it can't delete it I add a file control
2 Likes
With the correction on the line in question
If Len(Dir(Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG")) > 0 Then Kill Filepath & "\" & Filename & "-" & vSheetNames(i) & ".DWG"
It should be better:)
macro_export_pdf__dwg.swp
2 Likes
For the property, is it a custom property or the one integrated in Solidworks?
1 Like
it's a personal property ("DESCRIPTION") of the room (be careful, this property is not in the drawing)
I don't understand much about VBA, but digging into macros that I got back, I wonder if it doesn't correspond to this:
capture-4.jpg
Okay I didn't understand her :/ ok I'm looking
1 Like
Is there only one component per drawing or several?
1 Like
Only 1 component per MEP yes
Ok then try this:)
Thank you to our American friends :) https://forum.solidworks.com/message/431752#comment-431752
Macro in PC
macro_export_pdf__dwg.swp
5 Likes