Saving subassembly in a folder with its name

3D Design
1

Hello colleagues,

I couldn't find anything on the forum; I wonder if anyone would have a macro that saves the subassemblies in a folder that takes the name of the subassembly. In fact I received a WWTP from a customer and it has a good thirty under assembly and if I save it I have everything in a mess in the main folder while I would have liked a function to create the subfolders of each sub-assembly to store the parts.

Thank you in advance for your help

2 Likes
2

Good evening ac cobra 427

The attached macro does the job on an example of an assembly of about forty parts and 8 subassemblies on two levels.
The structure of the record is a quasi-copy of the SolidWorks tree: each assembly is saved in a folder with its name, along with the parts it contains, recursively.
This record is also true for the root assembly, which creates a copy of it.

To be tested with caution, there are no safeguards...

Kind regards.


saveastree.swp
2 Likes
3

Hello @m.blt ,

The macro works as it should, but would it be possible for it to work before the assembly is saved a 1st time? 

Thank you for the time spent because I have a real quiche in this area! 

4

Attached is the modified code, not sure if it is the cleanest but it seems functional.

If the path is empty, it will create a directory defined in the 3rd line (hard path to modify if necessary) Here "C:\Temp\AS_STEP\"

All your step files will therefore be copied into this folder and can be moved by closing the assembly. (copy paste from folder)

There is a way to make you choose the destination path but I don't remember how, so here is the solution chooses as a replacement.

Option Explicit
'On définit la constant pour le chemin si assemblage non eregistré
Public Const CheminConstante As String = "C:\Temp\AS_STEP\"


Sub TraitementAssemblage(swComp As SldWorks.Component2, ByVal Emplacement As String, ByVal nomfichier As String)

    Dim vChildComp              As Variant
    Dim swModelComponent        As SldWorks.ModelDoc2
    Dim swChildComp             As SldWorks.Component2
    Dim swCompConfig            As SldWorks.Configuration
    Dim nChild                  As Long
    Dim longStatus              As Boolean
    Dim dossier                 As String
    
    dossier = Emplacement & Left(nomfichier, Len(nomfichier) - 7) & "\"     ' Nom de dossier: celui de l'assemblage
    If Dir(dossier, vbDirectory) = "" Then
        MkDir dossier                                                       ' Création du dossier de l'assemblage
        Set swModelComponent = swComp.GetModelDoc2
        longStatus = swModelComponent.SaveAs3(dossier & nomfichier, 0, 0)   ' Enregistrement de l'assemblage dans son dossier
    Else
        Exit Sub
    End If
    
    vChildComp = swComp.GetChildren                         ' Liste des enfants de l'assemblage
    For nChild = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(nChild)
        nomfichier = Dir$(swChildComp.GetPathName)
        
        If UCase(Right(nomfichier, 6)) = "SLDASM" Then      ' Si c'est un assemblage: traitement récursif
            TraitementAssemblage swChildComp, dossier, nomfichier
            
        ElseIf UCase(Right(nomfichier, 6)) = "SLDPRT" Then  ' si c'est une pièce : enregistrement
            Set swModelComponent = swChildComp.GetModelDoc2
            longStatus = swModelComponent.SaveAs3(dossier & nomfichier, 0, 0)
        End If
        
    Next nChild
End Sub
 
 

Sub main()
            Dim swApp           As SldWorks.SldWorks
            Dim swModel         As SldWorks.ModelDoc2
            Dim swConf          As SldWorks.Configuration
            Dim swRootComp      As SldWorks.Component2
            Dim Emplacement     As String
            Dim nomfichier      As String

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Emplacement = swModel.GetPathName
    'On vérifie l'extension
    Dim FileTyp As Long
    FileTyp = swModel.GetType
    If Not FileTyp = swDocASSEMBLY Then
        MsgBox ("Le document doit être un assemblage...")
        Exit Sub
    End If
    If Emplacement = "" Then
        If Not Len(Dir(CheminConstante, vbDirectory)) > 0 Then
            MkDir CheminConstante
            Emplacement = CheminConstante
            Debug.Print swModel.GetTitle
            nomfichier = swModel.GetTitle & ".sldasm"

        Else
        nomfichier = swModel.GetTitle & ".sldasm"
        Emplacement = CheminConstante
        End If
    Else
        nomfichier = Dir$(Emplacement)                                  ' Nom du document d'assemblage principal
    End If

    Debug.Print Emplacement
    

    
    'If Right(Emplacement, 1) = "\" Then Emplacement = Left(Emplacement, Len(Emplacement) - 1)
    'Emplacement = Left(Emplacement, InStrRev(Emplacement, "\"))     ' Nom du dossier d'origine
    
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(False)
    TraitementAssemblage swRootComp, Emplacement, nomfichier        ' Comme c'est un assemblage: traitement
    swModel.Extension.SaveAs Emplacement & nomfichier, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, 0, 0

End Sub

Be careful, this macro does not work if you import 3Dinterconnect unless you break the link.

1 Like
5

Hello

I favored the @m.blt macro because it creates the folder with the subfolders in the source folder and all I have to do is delete the assembly and the parts saved beforehand. The @sbadenis macro saves the parts and asm in the source folder and creates a folder in Time with the sub-assembly sub-folders so I have to delete the asm and the parts as for the one of @m.blt but I have to do a cut and paste in addition to put everything back in the right folder. 

PS dsl for the delay in validating the best answer (a lot of work) and thank you both for taking the time.

1 Like