Hello
I am looking for a SolidWorks macro that allows, from an open part, to reconstruct and save the associated plans without opening them one by one.
Hello guillaume_pagnier,
To do what you ask, you have to pass " BachtConverter "
This allows you to do this and many other things too, but you have to be subscribed to MyCADTools.
Good luck.
@+.
AR.
1 Like
For the macro, I assume that the shots are saved in the same place as the room, and with the same name?
1 Like
Otherwise here is the functional code obtained thanks to chat GPT, which works quite well for very simplistic codes:
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
The prompt for those who are interested:
Macro VBA from a part, open the drawing, rebuild it and save it
And very often if the situation is good, you need to be able to correct the various mistakes of the cat!
2 Likes
Hello
Does this macro also work if multiple clips are associated with the same room?
Multiple shots are several sheets, or several different files with different names of the room, because they have nothing to do with each other.
You have to be very specific in the request.
An example or screenshot often avoids any misunderstandings.
1 Like
Multiple DRW files each with different names.
Only by having the PRT_33376 file, the goal is to reconstruct and save all the " CAO_xxxxx " drawings that are all related to the PRT_33376.
Here it becomes very complicated to find the drawings related to the part, in general a drawing has the same name as the part (and the sheets can possibly allow to have several drawings.)
The way it is done is far from ideal.
1 Like
The files are managed by a PLM, so their names are defined by the PLM and the fact that they have several plans is linked to the fact that they do not have the same distribution rights from each other.
1 Like
This code should work:
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
Be careful though it is not ideal since it scans the directory where the part is saved and for each slddrw file it looks if the linked reference corresponds to the open part.
So depending on the number of files in the directory it can very quickly become time-consuming.
There is surely a way via the pdm but not having it, impossible for me to propose something else.
It's up to you to test it and see if it suits you.
And hence the need to specify from the start how you work (pdm, the naming of mep...)
3 Likes
It's perfect, the functionality suits me, thank you very much for your time, is it possible not to close the drawings and leave them open once rebuilt and saved in order to directly store them in the PLM?
1 Like
To comment out a line, add a ' at the beginning of the line.
So for yours a ' in front of this line:
2 Likes
Thank you 
1 Like
Hello
If the PLM is Solidworks PDM, the easiest way would be to use Excel to get the links from the PRT to the different DRWs and to control their opening from Excel.
1 Like