J’utilise une macro basique pour enregistrer mes mise en plan en PDF/DWG que j’ai récupéré sur internet. Je souhaiterais la faire évoluer sur 2 points:
Ranger les PDF dans un sous dossier PDF et la même chose pour les DWG, dans mon dossier Mise en plan
je voudrais pouvoir ouvrir la pièce de ma mise en plan et crée STEP qui sera enregistrer dans un sous dossier de mon dossier pièces.
Je suis novice sur les macro SW et je suis un peu perdu, si quelqu’un peut m’aider
Voici le code :
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Path = Part.GetPathName 'Chemin du fichier
'Enregistrement PDF
Part.SaveAs2 Left(Path, (Len(Path) - 6)) & "PDF", 0, True, False '
'Enregistrement DWG
Part.SaveAs2 Left(Path, (Len(Path) - 6)) & "DWG", 0, True, False '
MsgBox " Enregistrement réussi", vbInformation
Set Part = Nothing
End Sub
Pour un sujet équivalent (dwg-pdf et step) voir celui-ci la macro de @Cyril.f est fonctionnel:
La seule chose à modifier si cela te convient sera l’ajout des dossiers. (Pdf, Dwg, Step)
¨Pour cela plusieurs méthode mais il faut savoir:
1-Si tes nom de fichier ont le même nombre de caractère ou pas, pour pouvoir récupérer le nom de dossier.
Et pour le step ici uniquement step sur pièce si assemblage cela ne fonctionnera pas.
Ensuite pour manipuler tes nom de fichier, dossier:
' PathName of current model document
Dim sModelFullPath As String
sModelFullPath = swModel.GetPathName
' get path name without filename
Dim sFilePath As String
sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))
' get filename and extension
Dim sFileName As String
sFileName = Right(sModelFullPath, Len(sModelFullPath) - InStrRev(sModelFullPath, "\"))
' get filename without extension
Dim sFileNameWithoutExtension As String
sFileNameWithoutExtension = Left(sFileName, InStrRev(sFileName, ".") - 1)
' combine everything to new path name
Dim sNewFullPath As String
sNewFullPath = prefix & sFileNameWithoutExtension & "REV" & CurrRev & ".pdf"
' SaveAs with new full path
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs sNewFullPath, 0, 0, swExportPDFData, 0, 0
Merci pour ce retour, j’ai tester le code mais ça ne fonctionne pas sur mon PC, j’ai un message qui me dit que j’ai un bloc non définie sur la ligne 118.
Pour ce qui est des fichiers il n’ont pas le même nombre de caractère, il sont constitué de la façon suivant:
XXXX-XXXX-XXX-XXX - Désignation
Concernant les step je ne cherche a faire que des mise ne plan de pièce.
Si je comprends bien le code suivant c’est pour ajouter le chemin pour l’enregistrement des fichiers des différents formats ?
Probablement l’indice (Revision) qu’il ne trouve pas.
Et avec ce code:
Option Explicit
Public Enum swDocumentTypes_e
swDocNONE = 0 ' Used to be TYPE_NONE
swDocPART = 1 ' Used to be TYPE_PART
swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY
swDocDRAWING = 3 ' Used to be TYPE_DRAWING
End Enum
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swConfig As SldWorks.Configuration
Dim vSheetNameArr As Variant
Dim vSheetName As Variant
Dim I As Long
Dim nDocType As Long
Dim op As Long
Dim suppr As Long
Dim lErrors As Long
Dim lWarnings As Long
Dim boolstatus As Boolean
Dim bRet As Boolean
Dim FileConnu As Boolean
Dim nbConnu As Integer
Dim sModelName As String
Dim sPathName As String
Dim TabConnu(10000) As String
Dim sConfigName As String
Dim sModelFullPath As String
Dim sFilePath As String
Dim sFileName As String
Dim sFileNameWithoutExtension As String
Sub main()
Set swApp = Application.SldWorks
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepAP, 214) 'Force la version AP214
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepExportPreference, swAcisOutputGeometryPreference_e.swAcisOutputAsSolidAndSurface) 'Force l'export en format Solid/Surface Geometry
Set swModel = swApp.ActiveDoc
' PathName of current model document
sModelFullPath = swModel.GetPathName
' get path name without filename
sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))
' get filename and extension
sFileName = Right(sModelFullPath, Len(sModelFullPath) - InStrRev(sModelFullPath, "\"))
' get filename without extension
sFileNameWithoutExtension = Left(sFileName, InStrRev(sFileName, ".") - 1)
Debug.Print sFilePath & "Pdf\" & sFileNameWithoutExtension & ".pdf"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Pdf\", vbDirectory) = vbNullString Then
MkDir sFilePath & "Pdf\"
End If
swModel.Extension.SaveAs sFilePath & "Pdf\" & sFileNameWithoutExtension & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Dwg\", vbDirectory) = vbNullString Then
MkDir sFilePath & "Dwg\"
End If
swModel.Extension.SaveAs sFilePath & "Dwg\" & sFileNameWithoutExtension & ".dwg", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Step\", vbDirectory) = vbNullString Then
MkDir sFilePath & "Step\"
End If
Call ExportStep
End Sub
Sub ExportStep()
Set swDraw = swModel
vSheetName = swDraw.GetSheetNames
vSheetNameArr = swDraw.GetSheetNames
For Each vSheetName In vSheetNameArr
bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
Set swView = swDraw.GetFirstView 'Sélectionne le fond de plan
Set swView = swView.GetNextView 'Passe à la vue suivante pour exclure le fond de plan
While Not swView Is Nothing
' Determine if this is a view of a part or assembly
sModelName = swView.GetReferencedModelName
sModelName = LCase(sModelName)
sConfigName = swView.ReferencedConfiguration
FileConnu = False
If InStr(sModelName, "sldprt") > 0 Then
nDocType = swDocPART
ElseIf InStr(sModelName, "slasm") > 0 Then
nDocType = swDocASSEMBLY
Else
nDocType = swDocNONE
Exit Sub
End If
If nDocType = 1 Then
For I = 1 To nbConnu
If UCase(sModelName) & " - " & UCase(sConfigName) = TabConnu(I) Then
FileConnu = True
End If
Next
If Not FileConnu Then
nbConnu = nbConnu + 1
TabConnu(nbConnu) = UCase(sModelName) & " - " & UCase(sConfigName)
Call Export
End If
End If
Set swView = swView.GetNextView
Wend
Next vSheetName
End Sub
Sub Export()
Set swModel = swApp.ActivateDoc3(sModelName, True, swOpenDocOptions_Silent, lErrors)
Set swModel = swApp.ActiveDoc
boolstatus = swModel.ShowConfiguration2(sConfigName)
Set swConfig = swModel.GetActiveConfiguration
sPathName = sFilePath & "Step\" & sFileNameWithoutExtension & ".step"
'sPathName = swModel.GetPathName & ".step"
If Dir(sPathName, vbHidden) <> "" Then 'Test l'existence du fichier
suppr = MsgBox("Le fichier " & sPathName & " existe déjà, voulez vous le supprimer?", vbYesNo) 'Message utilisateur confirmation de suppression oui/non
If suppr = vbYes Then 'Réponse Oui
Kill (sPathName) 'Suppression du fichier existant
swModel.SaveAs2 sPathName, 0, True, False 'Enregistrement du fichier
op = MsgBox("Le fichier a été enregistré sous " & sPathName & vbNewLine)
Else 'Réponse NON
MsgBox ("Fichier conservé") 'Message utilisateur
End If
Else
swModel.SaveAs2 sPathName, 0, True, False 'Enregistrement du fichier
op = MsgBox("Le fichier a été enregistré sous " & sPathName) 'Message utilisateur
End If
swApp.CloseDoc (sModelName)
Set swModel = swApp.ActiveDoc
End Sub
Si je peux j’ouvre un PC avec la 2023 pour tester mais pas possible pour l’instant.
Regarde si tu supprimes call ExportStep déjà si le pdf et le dwg sont bien fait pour commencer.
J’ai testé sur SW2023 les 3 fichiers sont bien exporté chez moi.
Cela ne vient donc pas du nom de fichier. Tes fichier sont en local ou sur réseaux?
Pas de caractère spéciaux dans ton chemin de fichier?
Essais en copiant sur C:\Temp\TesFichiers par exemple voir si cela fonctionne
Moi aussi je sèche!
Peut tu éditer la macro, ajouter les fenêtres Execution et Variables locales(voir image), puis cliquer juste après Sub main() et appuyer sur F8 juste qu’à ce que cela bug?
En gros lacer la macro en pas par pas. Et vérifier dans la fenêtre variable local la valeur de sModelName quand cela plante:
