Witam
Poszukuję makra SolidWorks, które pozwala, z otwartej części, zrekonstruować i zapisać powiązane plany bez otwierania ich jeden po drugim.
Witaj guillaume_pagnier,
Aby zrobić to, o co prosisz, musisz przejść " BachtConverter "
Pozwala to na zrobienie tego i wielu innych rzeczy, ale musisz być subskrybentem MyCADTools.
Powodzenia.
@+.
AR.
1 polubienie
W przypadku makro zakładam, że ujęcia są zapisane w tym samym miejscu co pomieszczenie i o tej samej nazwie?
1 polubienie
W przeciwnym razie oto funkcjonalny kod uzyskany dzięki czatowi GPT, który działa całkiem dobrze w przypadku bardzo uproszczonych kodów:
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
Podpowiedź dla zainteresowanych:
Makro VBA z części, otwórz rysunek, przebuduj go i zapisz
I bardzo często, jeśli sytuacja jest dobra, musisz być w stanie poprawić różne błędy kota!
2 polubienia
Witam
Czy to makro działa również wtedy, gdy wiele klipów jest powiązanych z tym samym pomieszczeniem?
Ujęcia wielokrotne to kilka arkuszy, lub kilka różnych plików o różnych nazwach pomieszczenia, ponieważ nie mają one ze sobą nic wspólnego.
W żądaniu musisz być bardzo konkretny.
Przykład lub zrzut ekranu często pozwala uniknąć nieporozumień.
1 polubienie
Wiele plików DRW, z których każdy ma inną nazwę.
Tylko mając plik PRT_33376, celem jest zrekonstruowanie i zapisanie wszystkich " CAO_xxxxx " rysunków, które są związane z PRT_33376.
Tutaj znalezienie rysunków związanych z częścią staje się bardzo skomplikowane, ogólnie rysunek ma taką samą nazwę jak część (a arkusze mogą ewentualnie pozwolić na posiadanie kilku rysunków).
Sposób, w jaki to się robi, jest daleki od ideału.
1 polubienie
Pliki są zarządzane przez PLM, więc ich nazwy są definiowane przez PLM, a fakt, że mają kilka planów, jest związany z faktem, że nie mają one takich samych praw dystrybucji od siebie.
1 polubienie
Ten kod powinien działać:
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
Bądź jednak ostrożny, nie jest to idealne rozwiązanie, ponieważ skanuje katalog, w którym część jest zapisana, i dla każdego pliku slddrw sprawdza, czy połączone odniesienie odpowiada otwartej części.
Tak więc, w zależności od liczby plików w katalogu, może to bardzo szybko stać się czasochłonne.
Na pewno jest sposób przez pdm, ale nie mając go, nie mogę zaproponować czegoś innego.
Od Ciebie zależy, czy go przetestujesz i zobaczysz, czy Ci odpowiada.
Stąd konieczność sprecyzowania od samego początku, jak się pracuje (pdm, nazewnictwo posła...)
3 polubienia
Jest idealny, funkcjonalność mi odpowiada, bardzo dziękuję za poświęcony czas, czy można nie zamykać rysunków i pozostawić je otwarte po odbudowaniu i zapisaniu w celu bezpośredniego przechowywania ich w PLM?
1 polubienie
Aby skomentować wiersz, dodaj ' na początku wiersza.
Więc dla twojego ' przed tą linią:
2 polubienia
Dziękuję 
1 polubienie
Witam
Jeśli PLM to Solidworks PDM, najprostszym sposobem byłoby użycie programu Excel w celu uzyskania łączy z PRT do różnych DRW i kontrolowania ich otwierania z programu Excel.
1 polubienie