Enregistrement de sous assemblage dans un dossier avec son nom

3D Design
1

Hello les collègues,

je n'ai rien trouvé sur le forum; je me demande si quelqu'un aurait une macro qui enregistre les sous assemblages dans un dossier qui reprend le nom du sous assemblage. En fait j'ai reçu un STEP d'un client et celui-ci comporte une bonne trentaine sous assemblage et si je l'enregistre j'ai tout en bordel dans le dossier principal alors que j'aurais aimé qu'une fonction me crée les sous dossiers de chaque sous assemblage pour y ranger les pièces.

Merci d'avance pour votre aide

2 « J'aime »
2

Bonsoir ac cobra 427

La macro jointe fait le job sur un exemple d'assemblage d'une quarantaine de pièces et de 8 sous-assemblages sur deux niveaux.
La structure de l'enregistrement est une quasi-copie de l'arbre de SolidWorks: chaque assemblage est enregistré dans un dossier à son nom, ainsi que les pièces qu'il contient, et ce de façon récursive.
Enregistrement vrai également pour l'assemblage racine, ce qui a pour effet d'en créer une copie.

A tester avec prudence, il n'y a pas de garde-fou...

Cordialement.


saveastree.swp
2 « J'aime »
3

Bonjour @m.blt ,

la macro fonctionne comme il faut par contre serait-il possible qu'elle fonctionne avant que l'assemblage soit enregistré une 1er fois? 

Merci pour le temps passé car je une une vrai quiche dans ce domaine! 

4

Ci-joint le code modifié, pas sûr que ce soit ce qu'il y a de plus propre mais cela semble fonctionnel.

Si le chemin est vide, il te créer un répertoire définie dans la 3ème lignes (chemin en dur à modifier si besoin) Ici "C:\Temp\AS_STEP\"

L'ensemble des tes fichier step seront donc copier dans ce dossier et déplaçable en fermant l'assemblage. (copier coller du dossier)

Il y a un moyen de faire choisir le chemin de destination mais je ne me rappelle plus comment, donc voici la solution choisit de remplacement.

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

Attention cette macro ne fonctionne pas si import 3Dinterconnect à moins de rompre le lien.

1 « J'aime »
5

Bonjour,

J'ai privilégié la macro de @m.blt car elle me crée le dossier avec les sous dossiers dans le dossier source et il ne me reste plus qu'à supprimer l'assemblage et les pièces enregistrées préalablement. La macro de @sbadenis enregistre les pièces et asm dans le dossier source et me crée un dossier dans le Temps avec les sous dossiers de sous assemblage donc je doit supprimer l'asm et les pièces comme pour celle de @m.blt mais je doit faire un couper coller en plus pour tout remettre dans le bon dossier.

PS dsl pour le retard de validation de la meilleur réponse ( beaucoup de travail) et merci à vous deux d'avoir pris le temps .

1 « J'aime »