Macro Mise en plan Solidworks PDF

valentin.fer · Juillet 7, 2023, 2:12

Bonjour Madame, Monsieur,

J’ai repris cette macro sur le net pour enregistrer mes mises en plans directement en pdf.
Malheureusement étant débutant dans le domaine, je ne sais pas comment ajouter le chemin du dossier d’enregistrement des mes mises en plans.

Quelqu’un peut-il m’indiqué la marche à suivre ?

Voici la macro que j’ai trouvé si cela peut aider, elle fonctionne mais enregistre les PDF dans le même dossier que mes mises en plan SW.

Merci d’avance !

Cordialement,

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Left(strFilename, Len(strFilename) - 6) & « pdf »
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

sbadenis · Juillet 7, 2023, 2:31

En m’inspirant de la réponse de @Cyril.f :

Ce code (non testé) devrait fonctionner

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename =  Mid(strFilename, InStrRev(strFilename, "\") + 1) 'Purge le chemin d'accès
strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & « pdf »
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

Cyril.f · Juillet 7, 2023, 3:47

Bonsoir,

En complément de la réponse de @sbadenis, le chemin d’enregistrement est fixe ou non?
Le code proposé enregistre sur le bureau.

valentin.fer · Juillet 10, 2023, 6:12

Bonjour Cyril,

Le chemin sera dans un dossier dédié au plan en PDF qui est différent de celui au format SW.
Mais dans le temps l’emplacement changera car je fonctionne par dossier de 1000 plans et cela va très vite. (dossier dans un serveur dédié)

Par ailleurs, je ne suis pas sur d’avoir compris ce que je dois faire dans la macro de @sbadenis et à quel endroit de doit ajouté mon chemin

Merci beaucoup pour vos réponses.

Cordialement

sbadenis · Juillet 10, 2023, 6:22

Le chemin était déjà ajouté en dur (vers le bureau)
Comment veux tu utiliser la macro?
Cas N°1 fichier par fichier la macro te demande ou tu veux enregistrer ton fichier à chaque fichier (ce qui peux être vite casse-pied si 100 fichiers à enregistrer)
Cas N°2 dans un sous répertoire de ton fichier (toujours identique)
Cas N°3 (celui que j’avais choisit) sur le bureau (Au besoin ajouter Plans/ derrière Desktop pour avoir un dossier sur le bureau) .

valentin.fer · Juillet 10, 2023, 7:14

D’accord, merci pour la précision.

J’ai un dossier Mise en plan PDF et à l’intérieur j’ai plusieurs dossiers ranger par tranche de 1000 plan pdf.

Exemple:

1-1000
1001-2000
2001-3000

Je pense que je vais mettre la macro en bouton dans ma barre d’outil et il enregistrera dans l’emplacement que j’ai choisi et je l’a changerai par la suite.

Il faut juste que je remplace le chemin vers le bureau avec celui que je veux si je comprends bien, je vais faire un essai.
Mon chemin actuel est comme ça :
O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000

Merci beaucoup Denis pour ta réponse.

Cordialement,

sbadenis · Juillet 10, 2023, 7:18

Dans ce cas tu change cette ligne:

strFilename = Environ("userprofile") & "\Desktop\" & strFilename 'Ajoute le bureau comme chemin en remplaçement (A modifier si besoin Ex: strFilename ="C:\Temp\strFilename

Par ```
strFilename = « O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000 »& strFilename

Et le jour ou tu aura dépassé tes 1000 tu changes de nouveau cette ligne dans la macro

valentin.fer · Juillet 10, 2023, 8:04

Malheureusement ça ne fonctionne pas

sbadenis · Juillet 10, 2023, 8:19

Effectivement erreur il manquait un \ après 19000, voici le code modifié et complet et testé:

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès
strFilename = "O:\Base SolidWorks\03-Bibliothèque PDF\18001-19000\" & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

Il faut également que le dossier 18001-19000 soit déjà existant avant de lancer la macro

valentin.fer · Juillet 10, 2023, 8:23

Ah Oui ! Bien vu

C’est parfait ça fonctionne !

Merci beaucoup !

valentin.fer · Juillet 10, 2023, 9:31

Par curiosité, Es ce que ce serait complexe, de faire retrouver automatique le bon dossier à la macro quand j’aurai passé le cap des numéros de plans ?

sbadenis · Juillet 10, 2023, 9:43

Si tu retrouves ton numéro dans le nom de la pièce cela est réalisable assez simplement.
en ajoutant juste en dssous de cette ligne:

strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès

Tu récupères les 2 1er chiffres et on modifie le nom du dossier en conséquence.
Cela ajouterais quelques ligne de code mais rien d’extraordinaire.
Par contre il faut également créé le dossier si inexistant.

valentin.fer · Juillet 10, 2023, 11:29

D’accord, je crois comprends le principe.

Actuellement, comme précisé précédemment, je fonctionne avec des dossiers nommé exactement ainsi : ( je les créé à l’avance)

17001-18000
18001-19000
19001-20000

Je vais devoir modifié le nom de mes dossiers pour faire fonctionné la macro ?

sbadenis · Juillet 10, 2023, 11:48

Non pour moi c’est réalisable via macro par contre cela rajouterais quelques lignes de code et il faut être sur que le nom de fichier de la MEP est bien compris lui aussi dans les valeurs indiqué par le dossier (exemple 18001.slddrw-> dossier 18001-19000)
Peut-tu donner le nom exact d’une mise en plan pour exemple?
Car l’idée serai de récupérer via macro les 1er chiffre et suivant ces chiffre d’enregistrer dans le répertoire existant ou de créer le dossier si on passe au millier supérieur.

sbadenis · Juillet 10, 2023, 12:24

Voici le code modifié pour la création automatique du nom de dossier si les MEp sont bien sous cette forme:
18001.slddrw, 19000.slddrw ou 20000.slddrw…

Dim swApp As Object
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swExportPDFData As SldWorks.ExportPdfData
Dim strFilename As String
Dim FolderName As String
Dim status As Boolean
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'Save
status = swModel.Save3(swSaveAsOptions_e.swSaveAsOptions_Silent, errors, warnings)
'Export to PDF if it is a drawing
If (swModel.GetType = swDocDRAWING) Then
strFilename = swModel.GetPathName
strFilename = Mid(strFilename, InStrRev(strFilename, "\") + 1)  'Purge le chemin d'accès
FolderName = Left(strFilename, Len(strFilename) - 7)
Debug.Print Right(FolderName, Len(FolderName) - 2)
If Right(FolderName, Len(FolderName) - 2) = "000" Then

'Si la MEP se termine par 000 on créer le dossier avec avec comme début de N° FolderName-1
FolderName = (Left(FolderName, Len(FolderName) - 3) - 1) & "001-" & (Left(FolderName, Len(FolderName) - 3)) & "000"
Else

'Si la MEP ne se termine pas par 000 on créer le dossier avec comme début de N° FolderName
FolderName = Left(FolderName, Len(FolderName) - 3) & "001-" & (Left(FolderName, Len(FolderName) - 3) + 1) & "000"
End If
FolderName = "O:\Base SolidWorks\03-Bibliothèque PDF\" & FolderName & "\"

'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(FolderName, vbDirectory + vbHidden) = "" Then
    MkDir FolderName
    End If



strFilename = FolderName & strFilename
strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf"
Debug.Print strFilename
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0
End If
End Sub

valentin.fer · Juillet 10, 2023, 12:41

Oui mes fichiers mise en plan sont bien nommé ainsi.

J’ai pu faire un test et cela fonctionne parfaitement.

Merci encore pour ton aide, c’est vraiment gentil