Macro pour PDF, DWG & SAT des pieces/mep d'un assemblage

Macro
1

Bonjour à tous,

Je suis actuellement entrain de modifier une macro (pdf_des_comosants_de_lassemblage.swp) que j’ai trouvé sur le forum pour que celle-ci puisse générer les DWG des mep et les SAT des pièces constituant l’assemblage. (Je ne sais pas si c’est possible mais est-il possible que la macro fasse la même chose pour tous les assemblages constituant l’assemblage de tête ?)
Je souhaite aussi que l’enregistrement de ces documents se fasse dans dans un dossier « PDF », « DWG » et « SAT » qui sont situé dans un dossier « CAO », qui est lui-même situé dans le même chemin que l’assemblage.

Je ne suis malheureusement pas super doué avec VBA donc je me tourne à vous en espérant que vous pourriez m’aider a ce sujet !

En vous remerciant d’avance !

pdf_des_composants_de_lassemblage.swp (54 Ko)

2

Bonjour;

Pourriez-vous éditer (copier) votre macro ici, plutôt que de la fournir sous forme de téléchargement ?
(en utilisant les balisesimage…) je ne suis pas un grand fan des macro à télécharger directement.

Ensuite, il nous manque du contexte pour vous aider:
Vos Mises en plan ont-elles le même nom que vos fichiers 3D et sont-elles dans le même repertoire ?
Faudra t’il ajouter une notion d’indice sur le nom des fichiers PDF et/ou DWG?
Quand vous évoquez vos sous-assemblages, sont-ils eux aussi dans le même repertoire que celui de tête ?
Un exemple de votre hiérarchie de repertoire serait appréciable.

Cordialement.

1 « J'aime »
3

Bonjour,

Merci pour votre réponse rapide !

Ci-dessous la macro d’enregistrement des pdf dans mon "C:" :

Sub ShowAllOpenFiles()
Dim swDoc As SldWorks.ModelDoc2
Dim swAllDocs As EnumDocuments2
Dim FirstDoc As SldWorks.ModelDoc2
Dim dummy As Boolean
Dim NumDocsReturned As Long
Dim DocCount As Long
Dim i As Long
Dim sMsg As String
Dim swApp As SldWorks.SldWorks
Dim bDocWasVisible As Boolean
Dim OpenWarnings As Long
Dim OpenErrors As Long
Dim DwgPath As String
Dim myDwgDoc As SldWorks.ModelDoc2
Dim drwPathName As String
Dim pdfPathName As String
Dim pdfFolderName As String
Dim swExportPDFData As SldWorks.ExportPdfData
Dim lErrors As Long
Dim lWarnings As Long
Dim boolstatus As Boolean

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\"

 
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
 
If (Not fso.FolderExists(pdfFolderName)) Then
MkDir pdfFolderName
'MsgBox (pdfFolderName + " does not exist")
'Exit Sub
End If
 
Dim Part As ModelDoc2
Set Part = swApp.ActiveDoc()
 
'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) + ".pdf")
Debug.Print pdfPathName
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False
Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings

'MsgBox ("PDF file was created")
    swApp.QuitDoc (Part.GetTitle)
            Set myDwgDoc = Nothing
        End If
    End If
    swAllDocs.Next 1, swDoc, NumDocsReturned
    DocCount = DocCount + 1
Wend
 
swApp.ActivateDoc FirstDoc.GetPathName
 
End Sub

Toutes les mep ont le même nom que la pièce/assemblage.
Il y’a une notion d’indice dans les propriétés que j’aimerai faire apparaitre apres le nom de la piece pour les PDF,DWG & SAT.

Structure des nom de fichier solidworks :

Nom-Titre-Description

Structure des noms PDF,DWG & SAT :

Nom-Indice-Titre-Description.

Hiérarchie :

Dans le dossier :

Assemblage1.SLDASM
Aseemblage1.SLDDRW
Dossier « CAO »

Dans le dossier « CAO » :

Dossier « PDF »
Dossier « DWG »
Dossier « SAT »
Piece1.SLDPRT
Piece1.SLDDRW
Piece2.SLDPRT
Piece2.SLDDRW
Assemblage2.SLDASM
Assemblage2.SLDDRW
…

4

Pas trop le temps de faire du dev mais dans ce sujet tu trouves les réponses pour modifier les chemins d’export.
Edit: avec le lien c’est mieux… :rofl:

5

Votre notion « d’indice » existe sur vos 3D ? (PDM ?)
Si ce n’est pas le cas, il ne sera pas facile de rapatrier cette notion sur les formats SAT (du moins sans tricher avec les info des MEP…)…

6

Non je n’ai pas PDM, je renseigne la notion d’indice dans mes propriétés perso et l’indice s’affiche sur mes mep.
Serait-il pas possible de faire en sorte que la macro aille récupéré l’indice dans les propriétés puis au moment de l’enregistrement on le fait ressortir comme :" Nom-Indice-Titre-Description " comme pour les PDF et DWG ?

7

vous trouverez un exemple ici pour ajouter des propriétés sur les noms de vos fichiers PDF et autres formats.