Zapisywanie podzespołu w folderze z jego nazwą

3D Design
1

Witam koleżanki i koledzy,

Nie mogłem nic znaleźć na forum; Zastanawiam się, czy ktoś miałby makro, które zapisuje podzespoły w folderze, który przyjmuje nazwę podzespołu. W rzeczywistości otrzymałem oczyszczalnię ścieków od klienta i ma ona dobre trzydzieści pod montażem, a jeśli ją zapiszę, mam wszystko w bałaganie w głównym folderze, podczas gdy wolałbym funkcję tworzenia podfolderów każdego podzespołu do przechowywania części.

Z góry dziękuję za pomoc

2 polubienia
2

Dobry wieczór ac cobra 427

Załączone makro spełnia swoje zadanie na przykładzie zespołu składającego się z około czterdziestu części i 8 podzespołów na dwóch poziomach.
Struktura rekordu jest quasi-kopią drzewa SolidWorks: każde złożenie jest zapisywane w folderze z jego nazwą, wraz z częściami, które zawiera, rekurencyjnie.
Ten rekord jest również prawdziwy dla zestawu głównego, który tworzy jego kopię.

Aby testować z ostrożnością, nie ma żadnych zabezpieczeń...

Pozdrowienia.


saveastree.swp powiedział:
2 polubienia
3

Witaj @m.blt ,

Makro działa tak, jak powinno, ale czy byłoby możliwe, aby zadziałało przed zapisaniem złożenia po raz 1? 

Dziękuję za poświęcony czas, bo mam prawdziwy quiche w tej okolicy! 

4

W załączeniu znajduje się zmodyfikowany kod, nie jestem pewien, czy jest najczystszy, ale wydaje się funkcjonalny.

Jeśli ścieżka jest pusta, utworzy katalog zdefiniowany w 3. wierszu (trudna ścieżka do modyfikacji w razie potrzeby) Tutaj "C:\Temp\AS_STEP\"

W związku z tym wszystkie pliki kroków zostaną skopiowane do tego folderu i można je przenieść, zamykając zestaw. (skopiuj wklej z folderu)

Istnieje sposób, aby zmusić Cię do wybrania ścieżki docelowej, ale nie pamiętam jak, więc oto rozwiązanie wybiera się jako zamiennik.

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

Bądź ostrożny, to makro nie działa w przypadku importowania 3Dinterconnect, chyba że połączenie zostanie przerwane.

1 polubienie
5

Witam

Faworyzowałem makro @m.blt , ponieważ tworzy folder z podfolderami w folderze źródłowym i wszystko, co muszę zrobić, to usunąć wcześniej zapisany zespół i części. Makro @sbadenis zapisuje części i asm w folderze źródłowym i tworzy folder w czasie z podfolderami podzespołów, więc muszę usunąć asm i części, jak w przypadku jednego z @m.blt , ale muszę wykonać wycięcie i wklejenie, oprócz tego, aby umieścić wszystko z powrotem we właściwym folderze. 

PS dsl za opóźnienie w walidacji najlepszej odpowiedzi (dużo pracy) i dziękuję obojgu za poświęcenie czasu.

1 polubienie