Je cherche un moyen de sortir en pdf mes 2 premières feuilles « ENSEMBLE » et « CABLAGE » puis ma 3ème feuille « FLAN AV » sur un autre pdf, ceux ci doivent s’enregistrer dans le dossier de la mise en plan, le premier pdf aura le nom de la mise en plan ex : P615PL702700 et le deuxième aura le même mais à la place du dernier caractère (ici un 0) on aura un 1.
J’ai réussi à sortir toutes les feuilles sur deux pdf séparés mais à chaque fois j’ai les 3 feuilles et non 2 + 1.
Je vois mais l’objectif ici est de créer une macro afin de rendre cet enregistrement plus rapide et répétable sur environ 200 fichiers, je veux faire un bouton de macro qui enregistre tout.
J’approche le résultat voulu avec ce 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
ici par contre ça m’enregistre seulement la feuille (0) la première
Ben si on a pas toutes les données dans l’énoncé il n’est pas commode de répondre correctement à vos attentes…
mais une piste de travail est disponible sur le site de Solidworks (le Forum):
' ------------------------------------------------------------------------------
' 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
Autant pour moi, je pensais avoir été clair lors de ma demande.
J’ai finalement réussi à trouver une solution après fusion de plusieurs code trouvés.
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