Subassemblage opslaan in een map met de bijbehorende naam

3D Design
1

Hallo collega's,

Ik kon niets vinden op het forum; Ik vraag me af of iemand een macro zou hebben die de subassemblages opslaat in een map die de naam van de subassemblage aanneemt. In feite heb ik een RWZI ontvangen van een klant en het heeft een goede dertig onderassemblage en als ik het opsla, heb ik alles in een puinhoop in de hoofdmap, terwijl ik graag een functie had gehad om de submappen van elke subassemblage te maken om de onderdelen op te slaan.

Bij voorbaat dank voor uw hulp

2 likes
2

Goedenavond ac cobra 427

De bijgevoegde macro doet het werk op een voorbeeld van een assemblage van ongeveer veertig onderdelen en 8 subassemblages op twee niveaus.
De structuur van het record is een quasi-kopie van de SolidWorks-boom: elke assembly wordt opgeslagen in een map met zijn naam, samen met de delen die het bevat, recursief.
Dit record geldt ook voor de root-assembly, die er een kopie van maakt.

Om met de nodige voorzichtigheid te worden getest, zijn er geen beveiligingen...

Vriendelijke groeten.


saveastree.swp
2 likes
3

Hallo @m.blt ,

De macro werkt zoals het hoort, maar zou het mogelijk zijn om te werken voordat de assemblage een 1e keer wordt opgeslagen? 

Bedankt voor de tijd die je hebt doorgebracht, want ik heb een echte quiche in dit gebied! 

4

Bijgevoegd is de gewijzigde code, niet zeker of het de schoonste is, maar het lijkt functioneel.

Als het pad leeg is, wordt er een map gemaakt die is gedefinieerd in de 3e regel (moeilijk pad om indien nodig te wijzigen) Hier "C:\Temp\AS_STEP\"

Al uw stapbestanden worden daarom naar deze map gekopieerd en kunnen worden verplaatst door de assembly te sluiten. (kopiëren en plakken uit map)

Er is een manier om je het bestemmingspad te laten kiezen, maar ik weet niet meer hoe, dus hier is de oplossing die als vervanging wordt gekozen.

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

Wees voorzichtig, deze macro werkt niet als u 3Dinterconnect importeert, tenzij u de link verbreekt.

1 like
5

Hallo

Ik gaf de voorkeur aan de @m.blt-macro omdat deze de map met de submappen in de bronmap maakt en ik alleen maar de assembly en de eerder opgeslagen onderdelen hoef te verwijderen. De @sbadenis macro slaat de onderdelen en asm op in de bronmap en maakt een map in Time met de subassemblage submappen, dus ik moet de asm en de onderdelen verwijderen zoals die van @m.blt , maar ik moet ook knippen en plakken om alles weer in de juiste map te zetten. 

PS dsl voor de vertraging bij het valideren van het beste antwoord (veel werk) en bedankt voor het nemen van de tijd.

1 like