Hallo
Ik ben op zoek naar een SolidWorks-macro waarmee ik vanuit een open deel de bijbehorende plannen kan reconstrueren en opslaan zonder ze één voor één te openen.
Hallo guillaume_pagnier,
Om te doen wat je vraagt, moet je slagen voor " BachtConverter "
Hierdoor kun je dit en nog veel meer dingen doen, maar je moet wel geabonneerd zijn op MyCADTools.
Succes.
@+.
AR.
1 like
Voor de macro ga ik ervan uit dat de opnames op dezelfde plek als de kamer en met dezelfde naam worden opgeslagen?
1 like
Anders is hier de functionele code die is verkregen dankzij chat GPT, die redelijk goed werkt voor zeer simplistische 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
De prompt voor degenen die geïnteresseerd zijn:
Macro VBA van een onderdeel, open de tekening, bouw deze opnieuw op en sla deze op
En heel vaak, als de situatie goed is, moet je in staat zijn om de verschillende fouten van de kat te corrigeren!
2 likes
Hallo
Werkt deze macro ook als er meerdere clips aan dezelfde ruimte zijn gekoppeld?
Meerdere shots zijn meerdere vellen, of meerdere verschillende bestanden met verschillende namen van de kamer, omdat ze niets met elkaar te maken hebben.
Je moet heel specifiek zijn in het verzoek.
Een voorbeeld of screenshot voorkomt vaak misverstanden.
1 like
Meerdere DRW-bestanden, elk met verschillende namen.
Alleen door het PRT_33376 bestand te hebben, is het doel om alle " CAO_xxxxx " tekeningen die allemaal verband houden met de PRT_33376 te reconstrueren en op te slaan.
Hier wordt het erg ingewikkeld om de tekeningen te vinden die betrekking hebben op het onderdeel, over het algemeen heeft een tekening dezelfde naam als het onderdeel (en de vellen kunnen het mogelijk maken om meerdere tekeningen te hebben.)
De manier waarop het wordt gedaan is verre van ideaal.
1 like
De bestanden worden beheerd door een PLM, dus hun namen worden bepaald door de PLM en het feit dat ze meerdere plannen hebben, houdt verband met het feit dat ze niet dezelfde distributierechten van elkaar hebben.
1 like
Deze code zou moeten werken:
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
Wees voorzichtig, maar het is niet ideaal, omdat het de map scant waar het deel is opgeslagen en voor elk slddrw-bestand wordt gekeken of de gekoppelde verwijzing overeenkomt met het geopende deel.
Dus afhankelijk van het aantal bestanden in de directory kan het al snel tijdrovend worden.
Er is zeker een manier via de pdm, maar als ik die niet heb, kan ik onmogelijk iets anders voorstellen.
Het is aan jou om het te testen en te kijken of het bij je past.
En dus de noodzaak om van bij het begin te specificeren hoe je werkt (pdm, de naamgeving van mep...)
3 likes
Het is perfect, de functionaliteit past bij mij, hartelijk dank voor je tijd, is het mogelijk om de tekeningen niet te sluiten en ze open te laten staan nadat ze zijn herbouwd en opgeslagen om ze direct in de PLM op te slaan?
1 like
Als u een regel wilt becommentariëren, voegt u een ' toe aan het begin van de regel.
Dus voor de jouwe een ' voor deze lijn:
2 likes
Bedankt 
1 like
Hallo
Als de PLM Solidworks PDM is, is de eenvoudigste manier om Excel te gebruiken om de links van de PRT naar de verschillende DRW's te krijgen en om hun opening vanuit Excel te regelen.
1 like