Macro enregistrement de toutes les mep en PDF avec indice de la pièce

_Cricri · Mars 27, 2023, 12:41

Bonjour,

J’ai récupérer ici une superbe macro pour enregistrer toutes les mep en pdf dans un dossier en 1 coup.
Par contre j’aurai besoin que le nom du pdf évolue avec l’indice de la pièce.
Ex: pièce « axe52 avec indice AB » devient lors de l’enregistrement en pdf « axe52-AB.pdf »
J’ai bien une macro qui fait ca mais plan par plan, donc quand tu as beaucoup de plans ca prends beaucoup de temps.
Si quelqu’un pouvait m’aider à faire de ces 2 macro une seul macro sa serait super. En réalisation de macro je suis novice
Merci d’avance pour votre aide

ci joint la macro que j’ai récupérer, merci par ailleurs à celui qui l’a faite
pdf_des_composants_de_lassemblage.swp (54 Ko)

ci joint la macro avec l’enregistrement en pdf avec l’indice
Enregistrement plan PDF+Indice.swp (33 Ko)

Zozo_mp · Mars 27, 2023, 12:46

Bonjour @_Cricri

Heureux de vous accueillir sur le forum.

J’espère que nous pourrons vous aider à résoudre quelques problèmes,
mais aussi que nous pourrons profiter de vos savoirs et expériences.

Nos six super-champions de la macro vont vous répondre

Cordialement

Cyril.f · Mars 27, 2023, 1:02

Bonjour,

Vous voulez absolument partir d’un assemblage pour récupérer les mises en plans ou traitement dans un dossier de toutes les mises en plans qui y sont?

_Cricri · Mars 27, 2023, 1:12

Bonjour Cyril.f
Les 2 solutions me vont, mais partir d’un assemblage permet de faire uniquement les plans de celui ci, c’est quoi le plus simple?

_Cricri · Mars 27, 2023, 1:13

Merci

Cyril.f · Mars 27, 2023, 1:26

Tout est faisable, c’est juste qu’il y a déjà des macro existantes qui traitent à partir d’un dossier.

_Cricri · Mars 27, 2023, 1:47

Je préfèrerai partir de l’assemblage comme dans la première macro cité « pdf_des_compsants_de_lassemblage »

Cyril.f · Mars 28, 2023, 5:24

Bonjour,
Voici le code issu des deux macros. je n’ai pas ajouté de contrôle en cas d’absence de la propriété « REVISION » , si par contre le lien est rompu entre le plan et le 3D ou qu’il n’y a pas de modèle rattaché, la macro passe son chemin sans créer le PDF (ceci peut être changé en déplaçant le End if).
Je n’ai également pas ajouté de contrôle de l’existence ou non du fichier PDF (et traitement associé)

' 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

_Cricri · Mars 28, 2023, 5:51

Bonjour,
MERCI Cyril.f ca fonctionne très bien.
Juste une petite chose encore j’aime rai bien avoir un tiret entre le nom et l’indice.
Ex: nom-AA
J’ai un peu regardé ta macro mais je ne pourrai pas dire ou rajouter se « - »

Cyril.f · Mars 28, 2023, 5:57

Faut changer cette ligne:

Par:

pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) + "-" +  revision + ".pdf")

_Cricri · Mars 28, 2023, 6:01

c’est effectivement la ligne ou j’avais ajouter le - mais je n’avais pas mis les " "
Merci Cyril.f

_Cricri · Mars 28, 2023, 6:40

Encore une chose, y a t’il moyen de faire les dxf également en même temps?

Cyril.f · Mars 28, 2023, 6:46

Oui mais du simple dxf du plan ou dans le cas de tôlerie avec une mise à plat?

_Cricri · Mars 28, 2023, 7:10

Oui un simple dxf de plan

Cyril.f · Mars 28, 2023, 7:23

Voici le code complet:

' 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

Je n’ai pas mis de vérification des paramètres d’export.

_Cricri · Mars 28, 2023, 8:42

Merci Cyril.f
Je n’arrive pas a trouver d’ou vient le . derrière l’indice pour les plans dxf
En gros j’ai nom-AA. pour les dxf

A.R · Mars 28, 2023, 8:48

Bonjour_cricri,
Juste pour information, si tu as accés aux outils « MycadTools », tu utilises 'BatchConverter".

Cette application est faite pour cela…
Bon courage.
@+.
AR.

Cyril.f · Mars 28, 2023, 8:57

Pardon, mal intégré.
Faut changer la ligne

dxfPathName = Left(pdfPathName, Len(pdfPathName) - 3)& ".dxf"

Par:

dxfPathName = Left(pdfPathName, Len(pdfPathName) - 3)& "dxf"

_Cricri · Mars 28, 2023, 9:02

Bonjour AR
Malheureusement je n’ai pas accès à l’outil Batch converter

_Cricri · Mars 28, 2023, 9:06

Pas besoin de dire pardon Cyril.f je suis déja super content d’avoir ton aide.
La macro fonctionne TRES BIEN, ca va changer la vie à mes nouveaux collègues.
Ca fait à peine 3 mois que je suis sur solidworks par contre j’ai 25 ans de Créo derrière moi.