Hello
Do you absolutely want to start from an assembly to retrieve the drawings or processing in a folder of all the drawings that are there?
Hello Cyril.f
The 2 solutions are fine with me, but starting from an assembly allows you to make only the plans of it, what is the easiest?
Thank you
Everything is doable, it's just that there are already existing macros that deal from a folder.
I would prefer to start from the assembly as in the first macro mentioned "pdf_des_compsants_de_lassemblage"
Hello
Here is the code from the two macros. I didn't add a control in case of absence of the "REVISION" property, if on the other hand the link is broken between the plan and the 3D or there is no model attached, the macro goes its way without creating the PDF (this can be changed by moving the End if).
I also didn't add a check on whether or not the PDF file exists (and associated processing)
' Description:
' Traverses the open assembly and activates all components and their drawings (if of the
' same name).
Option Explicit
Dim fso As Scripting.FileSystemObject
Dim swApp As SldWorks.SldWorks
Dim myDwgDoc As SldWorks.ModelDoc2
Dim swDoc As SldWorks.ModelDoc2
Dim FirstDoc As SldWorks.ModelDoc2
Dim swRefDoc As SldWorks.ModelDoc2
Dim Part As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swExportPDFData As SldWorks.ExportPdfData
Dim swView As SldWorks.View
Dim swAllDocs As EnumDocuments2
Dim NumDocsReturned As Long
Dim DocCount As Long
Dim i As Long
Dim OpenWarnings As Long
Dim OpenErrors As Long
Dim lErrors As Long
Dim lWarnings As Long
Dim dummy As Boolean
Dim bDocWasVisible As Boolean
Dim boolstatus As Boolean
Dim sMsg As String
Dim DwgPath As String
Dim drwPathName As String
Dim pdfPathName As String
Dim pdfFolderName As String
Dim revision As String
Sub ShowAllOpenFiles()
Set swApp = Application.SldWorks
Set swAllDocs = swApp.EnumDocuments2
Set FirstDoc = swApp.ActiveDoc
DocCount = 0
swAllDocs.Reset
swAllDocs.Next 1, swDoc, NumDocsReturned
While NumDocsReturned <> 0
bDocWasVisible = swDoc.Visible
'swApp.ActivateDoc swDoc.GetPathName'
DwgPath = swDoc.GetPathName
If (LCase(Right(DwgPath, 3)) <> "drw") And (DwgPath <> "") Then
DwgPath = Left(DwgPath, Len(DwgPath) - 3) & "drw"
Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)
If Not myDwgDoc Is Nothing Then
swApp.ActivateDoc myDwgDoc.GetPathName
pdfFolderName = "C:\pdf files\"
Set fso = CreateObject("Scripting.FileSystemObject")
If (Not fso.FolderExists(pdfFolderName)) Then
MkDir pdfFolderName
'MsgBox (pdfFolderName + " does not exist")
'Exit Sub
End If
Set Part = swApp.ActiveDoc()
Set swDraw = Part
Set swView = swDraw.GetFirstView 'active/récupère le fond de plan pour les propri perso
Set swView = swView.GetNextView 'active/récupère la première vue pour les propri perso
Set swRefDoc = swView.ReferencedDocument ' On a maintenant swRefDoc le 3D de la mise en plan
If Not swRefDoc Is Nothing Then 'Vérification si fichier rattaché à la vue existe (lien rompu par exemple)
revision = swRefDoc.GetCustomInfoValue("", "REVISION") ' on récupère la propriété revision
'You have a drawing active
drwPathName = Part.GetPathName()
If ("" = drwPathName) Then
' GetPathName() was empty
MsgBox ("This drawing has not been saved yet")
Exit Sub
End If
pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) + revision + ".pdf")
Debug.Print pdfPathName
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False
Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings
End If 'Déplacer ce End If juste après revision = swRefDoc.GetCustomInfoValue("", "REVISION") si le pdf doit tout de même être généré
'MsgBox ("PDF file was created")
swApp.QuitDoc (Part.GetTitle)
Set myDwgDoc = Nothing
Set swRefDoc = Nothing
Set Part = Nothing
Set swDraw = Nothing
End If
End If
swAllDocs.Next 1, swDoc, NumDocsReturned
DocCount = DocCount + 1
Wend
swApp.ActivateDoc FirstDoc.GetPathName
Set FirstDoc = Nothing
Set swApp = Nothing
End Sub
3 Likes
Hello
THANK YOU Cyril.f it works very well.
Just one more thing, I like to have a dash between the name and the clue.
Ex: name-AA
I looked at your macro a little but I won't be able to say or add "-"
You have to change this line:
By:
pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) + "-" + revision + ".pdf")
4 Likes
One more thing, is there a way to do the dxf at the same time as well?
Yes, but from the simple dxf of the plan or in the case of sheet metal with a flattening?
Yes, a simple dxf of plan
Here's the full code:
' Description:
' Traverses the open assembly and activates all components and their drawings (if of the
' same name).
Option Explicit
Dim fso As Scripting.FileSystemObject
Dim swApp As SldWorks.SldWorks
Dim myDwgDoc As SldWorks.ModelDoc2
Dim swDoc As SldWorks.ModelDoc2
Dim FirstDoc As SldWorks.ModelDoc2
Dim swRefDoc As SldWorks.ModelDoc2
Dim Part As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swExportPDFData As SldWorks.ExportPdfData
Dim swView As SldWorks.View
Dim swAllDocs As EnumDocuments2
Dim NumDocsReturned As Long
Dim DocCount As Long
Dim i As Long
Dim OpenWarnings As Long
Dim OpenErrors As Long
Dim lErrors As Long
Dim lWarnings As Long
Dim dummy As Boolean
Dim bDocWasVisible As Boolean
Dim boolstatus As Boolean
Dim sMsg As String
Dim DwgPath As String
Dim drwPathName As String
Dim pdfPathName As String
Dim pdfFolderName As String
Dim dxfPathName As String
Dim revision As String
Sub ShowAllOpenFiles()
Set swApp = Application.SldWorks
Set swAllDocs = swApp.EnumDocuments2
Set FirstDoc = swApp.ActiveDoc
DocCount = 0
swAllDocs.Reset
swAllDocs.Next 1, swDoc, NumDocsReturned
While NumDocsReturned <> 0
bDocWasVisible = swDoc.Visible
'swApp.ActivateDoc swDoc.GetPathName'
DwgPath = swDoc.GetPathName
If (LCase(Right(DwgPath, 3)) <> "drw") And (DwgPath <> "") Then
DwgPath = Left(DwgPath, Len(DwgPath) - 3) & "drw"
Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)
If Not myDwgDoc Is Nothing Then
swApp.ActivateDoc myDwgDoc.GetPathName
pdfFolderName = "C:\pdf files\"
Set fso = CreateObject("Scripting.FileSystemObject")
If (Not fso.FolderExists(pdfFolderName)) Then
MkDir pdfFolderName
'MsgBox (pdfFolderName + " does not exist")
'Exit Sub
End If
Set Part = swApp.ActiveDoc()
Set swDraw = Part
Set swView = swDraw.GetFirstView 'active/récupère le fond de plan pour les propri perso
Set swView = swView.GetNextView 'active/récupère la première vue pour les propri perso
Set swRefDoc = swView.ReferencedDocument ' On a maintenant swRefDoc le 3D de la mise en plan
If Not swRefDoc Is Nothing Then 'Vérification si fichier rattaché à la vue existe (lien rompu par exemple)
revision = swRefDoc.GetCustomInfoValue("", "REVISION") ' on récupère la propriété revision
'You have a drawing active
drwPathName = Part.GetPathName()
If ("" = drwPathName) Then
' GetPathName() was empty
MsgBox ("This drawing has not been saved yet")
Exit Sub
End If
pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) & "-" & revision & ".pdf")
dxfPathName = Left(pdfPathName, Len(pdfPathName) - 3) & "dxf"
Debug.Print pdfPathName
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False
Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings
boolstatus = Part.SaveAs4(dxfPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, lErrors, lWarnings)
End If 'Déplacer ce End If juste après revision = swRefDoc.GetCustomInfoValue("", "REVISION") si le pdf doit tout de même être généré
'MsgBox ("PDF file was created")
swApp.QuitDoc (Part.GetTitle)
Set myDwgDoc = Nothing
Set swRefDoc = Nothing
Set Part = Nothing
Set swDraw = Nothing
End If
End If
swAllDocs.Next 1, swDoc, NumDocsReturned
DocCount = DocCount + 1
Wend
swApp.ActivateDoc FirstDoc.GetPathName
Set FirstDoc = Nothing
Set swApp = Nothing
End Sub
I didn't put a check of the export settings.
1 Like
Thank you Cyril.f
I can't find where the . Behind the index for DXF plans
Basically, I have name-AA. For DXFs
Bonjour_cricri,
Just for information, if you have access to the " MycadTools " tools, you use "BatchConverter".
This app is made for that...
Good luck.
@+.
AR.
Sorry, poorly integrated.
We have to change the line
dxfPathName = Left(pdfPathName, Len(pdfPathName) - 3)& ".dxf"
By:
dxfPathName = Left(pdfPathName, Len(pdfPathName) - 3)& "dxf"
Hello AR
Unfortunately I don't have access to the Batch converter tool
No need to say sorry Cyril.f I'm already super happy to have your help.
The macro works VERY WELL, it will change the life of my new colleagues.
I've been on solidworks for barely 3 months, but I have 25 years of Creo behind me.
ok that's what I thought...
Good luck!!!
@+.
AR.
Hello @_Cricri ,
A different approach from that of @Cyril.f , derived from a macro from the www.codestack.net site.
Use this macro to export drawings of the components of an assembly to subfolders in the assembly's root directory:
- in PDF format in a subfolder pdf_files ;
- DXF in a subfolder dxf_files
- in DWG format in a subfolder dwg_files.
For each component, drawings are searched in its backup folder and subfolders, and do not necessarily have the same name as the 3D model.
In principle, therefore, to be tested...
Kind regards.
AssyCompsMEPsaveAsPdfDxfDwg.swp (107.5 KB)
2 Likes