Bonjour,
Je suis à la recherche d’une macro SolidWorks permettant, à partir d’une pièce ouverte, de reconstruire et enregistrer les plans associés sans les ouvrir un à un.
Bonjour guillaume_pagnier,
Pour faire ce que tu demande, il faut passer « BachtConverter »
Se qui te permet de faire cela et plein d’autres choses aussi, mais il faut être abonné à MyCADTools.
Bon courage.
@+.
AR.
1 « J'aime »
Pour la macro, je suppose que les plans sont enregistré au même endroit que la pièce, et avec le même nom?
1 « J'aime »
Sinon voici le code fonctionnel obtenu grace à chat GPT, qui fonctionne assez bien pour des codes très simpliste:
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim partPath As String
Dim drawingPath As String
Dim swDrawing As SldWorks.ModelDoc2
Dim errors As Long, warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Aucun document ouvert."
Exit Sub
End If
If swModel.GetType <> swDocPART Then
MsgBox "Le document actif n'est pas une pièce."
Exit Sub
End If
' Obtenir le chemin complet de la pièce
partPath = swModel.GetPathName
If partPath = "" Then
MsgBox "La pièce doit être enregistrée pour localiser la mise en plan."
Exit Sub
End If
' Remplacer l'extension .SLDPRT par .SLDDRW
drawingPath = Left(partPath, InStrRev(partPath, ".")) & "SLDDRW"
' Vérifier si le fichier de mise en plan existe
If Dir(drawingPath) = "" Then
MsgBox "Le fichier de mise en plan n'existe pas : " & drawingPath
Exit Sub
End If
' Ouvrir la mise en plan
Set swDrawing = swApp.OpenDoc6(drawingPath, swDocDRAWING, swOpenDocOptions_Silent, "", errors, warnings)
If swDrawing Is Nothing Then
MsgBox "Erreur lors de l'ouverture de la mise en plan."
Exit Sub
End If
' Activer le document de mise en plan
swApp.ActivateDoc3 swDrawing.GetTitle, False, swRebuildOnActivation_e.swRebuildActiveDoc, errors
' Reconstruire
swDrawing.ForceRebuild3 False
' Enregistrer
swDrawing.Save3 swSaveAsOptions_Silent, errors, warnings
MsgBox "Mise en plan reconstruite et enregistrée avec succès.", vbInformation
End Sub
Le prompt pour ceux que ça intéresse:
macro vba a partir d’une pièce, ouvrir la mise en plan, la reconstruire et l’enregistrer
Et bien souvent si la bas est bonne, il faut pouvoir corriger les différentes erreurs du chat!
2 « J'aime »
Bonjour,
Cette macro fonctionne aussi si plusieurs plans sont associés à une même pièce ?
Plusieurs plans, c’est plusieurs feuilles, ou plusieurs fichiers différents avec des noms différents de la pièce, parce que cela n’a rien à voir.
Il faut être bien précis dans la demande.
Un exemple ou une capture d’écran évite souvent tout malentendu.
1 « J'aime »
Plusieurs fichiers DRW avec chacun des noms différents.
Seulement en ayant le fichier PRT_33376, le but est de reconstruire et enregistrer toutes les mises en plan « CAO_xxxxx » qui sont toutes liés au PRT_33376.
Là cela se complique fortement pour trouver les mises en plan lié à la pièce, en générale une mise en plan a le même nom que la pièce (et les feuille peuvent éventuellement permettre d’avoir plusieurs mise en plan.)
La façon de faire est loin d’être idéal.
1 « J'aime »
Les fichiers étant géré par un PLM, leurs noms sont donc définis par ce dernier et le fait d’avoir plusieurs plan est lié au fait qu’ils n’ont pas les mêmes droits de diffusion les uns des autres.
1 « J'aime »
Ce code devrait fonctionner :
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawDoc As SldWorks.ModelDoc2
Dim fileName As String
Dim pathNoExt As String
Dim drawingPath As String
Dim fso As Object
Dim folderPath As String
Dim file As Object
Dim folder As Object
Dim found As Boolean
Dim refs As Variant
Dim i As Integer
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Aucun document actif.", vbExclamation
Exit Sub
End If
If swModel.GetType <> swDocPART Then
MsgBox "Le document actif n'est pas une pièce (.SLDPRT).", vbExclamation
Exit Sub
End If
' Obtenir le chemin complet de la pièce
fileName = swModel.GetPathName
If fileName = "" Then
MsgBox "La pièce n'est pas enregistrée. Enregistrez-la avant de lancer la macro.", vbExclamation
Exit Sub
End If
' Chemin sans extension
pathNoExt = Left(fileName, InStrRev(fileName, ".") - 1)
drawingPath = pathNoExt & ".slddrw" ' ? correction ici
Set fso = CreateObject("Scripting.FileSystemObject")
found = False
' Cherche dans le même dossier tous les dessins .slddrw
folderPath = Left(fileName, InStrRev(fileName, "\") - 1)
Set folder = fso.GetFolder(folderPath)
For Each file In folder.Files
Debug.Print file
If LCase(fso.GetExtensionName(file.Name)) = "slddrw" Then ' ? bonne extension
Set swDrawDoc = swApp.OpenDoc6(file.Path, swDocDRAWING, swOpenDocOptions_Silent, "", 0, 0)
If Not swDrawDoc Is Nothing Then
refs = swDrawDoc.GetDependencies(False, False)
For i = 0 To UBound(refs)
If LCase(refs(i)) = LCase(fileName) Then
' Dessin lié à la pièce active trouvé
swDrawDoc.ForceRebuild3 False
swDrawDoc.Save
swApp.CloseDoc swDrawDoc.GetTitle
found = True
Exit For
End If
Next i
' Si pas lié, fermer sans enregistrer
If Not found Then
swApp.CloseDoc swDrawDoc.GetTitle
End If
End If
End If
Next
If Not found Then
MsgBox "Aucun fichier mise en plan lié trouvé.", vbInformation
Else
MsgBox "Traitement des mises en plan terminé.", vbInformation
End If
End Sub
Attention cependant il n’est pas idéal puisque qu’il scan le répertoire ou la pièce est enregistrer et pour chaque fichier slddrw il regarde si la référence lié correspond à la pièce ouverte.
Donc suivant le nombre de fichier dans le répertoire cela peut très vite devenir chronophage.
Il existe sûrement un moyen via le pdm mais ne le possédant pas impossible pour moi de proposer autre chose.
A toi de tester et de voir si cela te convient.
Et d’où le besoin de bien préciser dès le départ ton fonctionnement (pdm, le nommage des mep…)
3 « J'aime »
C’est parfait la fonctionnalité me convient merci beaucoup pour votre temps, est-il possible de ne pas fermer les mises en plans et les laisser ouvertes une fois reconstruite et enregistrée afin de directement les ranger dans le PLM ?
1 « J'aime »
Pour mettre une ligne en commentaire ajouter un ’ en début de ligne.
Donc pour la tienne un ’ devant cette ligne:
2 « J'aime »
Merci 
1 « J'aime »
Bonjour,
Si le PLM est Solidworks PDM, le plus simple serait de passer par Excel pour obtenir les liens du PRT vers les différents DRW et de piloter leur ouverture depuis Excel.
1 « J'aime »