I have always tested on the same file. the drawing of a cap. The drawing is in a different folder than the parts, but the files have the same name.
I've already looked at the code by doing it step by step, and since I don't know too much about it I don't know how to correctly identify the problems.
To launch the macro I made a button and I also tried with the play key.
Yes for the subfolders for the moment I haven't done anything but pasted the 3 variables to be defined. Because I try to make the code work every time. I took the basic code without making any changes except to remove the Revision in the file name.
It worked once, I deleted the generated files and started again and there I had the error below
And no I haven't yet tested the code of the 4th answer @Cyril.f
Good news. All that remains is to validate the " Best answer " to close this discussion.
And see you soon for new macros... In the meantime, I advise you to consult different sites (not always in French -Visual Basic- obliges) but often didactic to get started in programming:
If you take the code of the 5th message, it puts the files in the pdf directories Dwg and Step. I think you're mixing brushes with the different versions of the macro. Here is the example already mentioned above:
Indeed as much for me I didn't look at it well, sorry for all these exchanges!
I just have a quick note, the STEP folder is created in the Drawing folder, and I would like it to be created in the parts folder. Here is the tree structure of my files: 1-Assembly 2-Pieces / STEP 3-Drawing / PDF - /DWG
Adding something like this should be better (not tested):
'On revient un dossier en arrière puis on ajoute le dossier Pièces
sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))
sFilePath = sFilePath & "Pièces\"
Surely one \ too much or less, what is the value of sFilePath just before? If needed to verify it added debug.print sFilepath, just below the previous 3 lines and look at the value in the "Execution" window via macro display editing
Does the documents file always exist and is it always codified in the same way? Basically, for example, is it this type of tree? C:\xxxx\Parts C:\xxxx\Drawings
Basically, not optimized and no check if the files already exist:
Option Explicit
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 sFilePathStep As String
Dim sFileName As String
Dim sFileNameWithoutExtension As String
Dim fs As Scripting.FileSystemObject
Const dxfSubFolder = "dwg\"
Const pdfSubFolder = "pdf\"
Const stepSubFolder = "2 - Pieces\step\"
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, "\"))
sFilePathStep = Left(sFilePath, InStrRev(sFilePath, "\", Len(sFilePath) - 1))
Debug.Print sFilePathStep
' get filename and extension
sFileName = Right(sModelFullPath, Len(sModelFullPath) - InStrRev(sModelFullPath, "\"))
' get filename without extension
sFileNameWithoutExtension = Left(sFileName, InStrRev(sFileName, ".") - 1)
Debug.Print sFilePath & pdfSubFolder & sFileNameWithoutExtension & ".pdf"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
CreateRep (sFilePath & pdfSubFolder)
swModel.Extension.SaveAs sFilePath & pdfSubFolder & sFileNameWithoutExtension & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
CreateRep (sFilePath & dxfSubFolder)
swModel.Extension.SaveAs sFilePath & dxfSubFolder & sFileNameWithoutExtension & ".dwg", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
CreateRep (sFilePathStep & stepSubFolder)
Call ExportStep
End Sub
Function CreateRep(sRep As String)
Set fs = New Scripting.FileSystemObject
If Not fs.FolderExists(sRep) Then
fs.CreateFolder (sRep)
End If
Set fs = Nothing
End Function
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 = sFilePathStep & stepSubFolder & sFileNameWithoutExtension & ".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
For it to work, you have to select " Microsoft Scripting Runtime " in the references:
On this part of code I have to change what for the macro to work?
'On revient un dossier en arrière puis on ajoute le dossier Pièces
sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))
sFilePath = sFilePath & "2 - Pièces\"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier STEP
If Dir(sFilePath & "Step\", vbDirectory) = vbNullString Then
MkDir sFilePath & "Step\"
End If
