Hi all
I'm looking for a way to print my first 2 sheets " TOGETHER " and " CABLING " in pdf and then my 3rd sheet " FLAN AV " on another pdf, these must be saved in the drawing folder, the first pdf will have the name of the drawing e.g. P615PL702700 and the second will have the same but instead of the last character (here a 0) we will have a 1.
I managed to get all the sheets out on two separate pdfs but each time I have the 3 sheets and not 2 + 1.
Thanks in advance
Hello:
To combine existing PDF files or when printing I use PDF_Redirect...
See:
I see but the goal here is to create a macro in order to make this recording faster and repeatable over about 200 files, I want to make a macro button that saves everything.
I approach the desired result with this code:
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
If swExportPDFData Is Nothing Then MsgBox "Nothing"
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, vSheetNames(0))
swExportPDFData.ViewPdfAfterSaving = True
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & Filename & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
End Sub
here on the other hand it only saves me the sheet (0) the first one
Well, if we don't have all the data in the statement, it's not easy to meet your expectations correctly...
but a work path is available on the Solidworks website (the Forum):
Written by: @Deepak_Gupta :
' ------------------------------------------------------------------------------
' Written by: Deepak Gupta (http://gupta9665.com/)
' -----------------------------------------------------------------------------
' Version 2: Added option for selecting Output folder ------------- 08/07/14
' Version 2.1: Added revision in file name ------------- 01/20/15
Option Explicit
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
Function BrowseFolder(Optional Caption As String, _
Optional InitialFolder As String) As String
Dim SH As Shell32.Shell
Dim F As Shell32.Folder
Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder = "Desktop")
If Not F Is Nothing Then
BrowseFolder = F.Items.Item.Path
End If
End Function
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim vSheetNameArr As Variant
Dim vSheetName As Variant
Dim bRet As Boolean
Dim swExportPDFData As SldWorks.IExportPdfData
Dim lErrors As Long
Dim lWarnings As Long
Dim Path As String
Dim Value As String
Set swApp = Application.SldWorks
Path = BrowseFolder("Select a Path/Folder")
If Path = "" Then
MsgBox "Please select the path and try again"
End
Else
Path = Path & "\"
End If
Set swModel = swApp.ActiveDoc
' Is document active?
If swModel Is Nothing Then
swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk
Exit Sub
End If
' Is it a Drawing document?
If swModel.GetType <> swDocDRAWING Then
swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk
Exit Sub
End If
Set swDraw = swModel
Value = swDraw.CustomInfo("Revision")
Set swSheet = swDraw.GetCurrentSheet
vSheetNameArr = swDraw.GetSheetNames
Dim numberOfSheets As Integer
numberOfSheets = swModel.GetSheetCount
Dim i As Integer
i = 0
Dim sales(0) As Variant
Dim fab(1) As Variant
MsgBox vSheetNameArr(0)
Set swExportPDFData = swApp.GetExportFileData(1)
Do While i < numberOfSheets
sales(0) = vSheetNameArr(i)
fab(0) = vSheetNameArr(i + 1)
fab(1) = vSheetNameArr(i + 2)
swExportPDFData.SetSheets swExportData_ExportSpecifiedSheets, sales
swModel.Extension.SaveAs Path & sales(0) & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings
swExportPDFData.SetSheets swExportData_ExportSpecifiedSheets, fab
swModel.Extension.SaveAs Path & fab(0) & " & QC " & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings
i = i + 3
Loop
End Sub
As much for me, I thought I had been clear when I asked.
I finally managed to find a solution after merging several codes found.
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(4) 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
File = Part.GetPathName
Dim Filepath As String
Dim Filename As String
Dim Filename2 As String
Filepath = Left(File, InStrRev(File, "\"))
Filename = Mid(File, Len(Filepath) + 1, Len(File) - (7 + Len(Filepath)))
Filename2 = Filename2 = Left(Filename, Len(Filename) - 1) & "1"
Dim PartName As String
PartName = Part.GetTitle
PartName = Split(PartName, " - ")(0) ' Résultat : "P615PL702700"
Dim PartNameAlt As String
PartNameAlt = Left(PartName, Len(PartName) - 1) & "1" ' P615PL702701
Set swModelDocExt = Part.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swDraw = Part
strSheetName(0) = "ENSEMBLE"
strSheetName(1) = "CABLAGE"
vSheetNames = strSheetName
If swExportPDFData Is Nothing Then MsgBox "Nothing"
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, vSheetNames)
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & PartName & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
strSheetName(0) = "FLAN AV"
strSheetName(1) = ""
vSheetNames = strSheetName
boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, vSheetNames)
boolstatus = swModelDocExt.SaveAs(Filepath & "\" & PartNameAlt & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings)
End Sub