SW: Wielokrotny eksport dxf z 3D

Cze wszystkim

Szukam makra do wykonywania eksportu .dxf wszystkich 3D obecnych w pliku. Pozwól, że wyjaśnię, wszystkie moje pliki 3D z blachą znajdują się w folderze klienta i chciałbym, aby każda część była rozwijana po uruchomieniu makra i zapisywaniu jej jako opcji arkusza blachy w formacie .dxf. 

Przyjrzałem się temu, co istniało w sieci, ale nie mogłem znaleźć odpowiednika moich badań. 

Z góry dziękuję

Witam

Spójrz na harmonogram zadań, aby sprawdzić, czy jest kilka rzeczy.

Konwerter wsadowy (narzędzie z pakietu mycadservices premium)

1 polubienie

Wyjaśnienie tutaj, zobacz na końcu filmu, aby zapoznać się z opcjami eksportowania części arkusza blachy w formacie dxf:  http://youtu.be/wJeSg5cO06s

1 polubienie

Niestety mam tylko standardową wersję SW, więc chciałem przejść przez makro.

Oto podstawowa funkcja zawarta w Solidworks (bez potrzeby korzystania z narzędzia innej firmy...):

Eksport DXF-DWG - Strona 1

Eksport DXF-DWG - Strona 2

Następnie, patrząc na jego funkcje od strony makro, powinien istnieć sposób, aby go zautomatyzować...

Nie mogę pomóc od strony makro.

Dzięki Olivier, znam tę metodę, ale kiedy masz folder z kilkoma kawałkami do przekształcenia w .dxf, jest on bardzo długi...

Więc chciałem w ten sam sposób co to makro => dwg do pdf , ale przejść z Sldprt do .dxf

 

 

Witam

Oto fragment kodu, który pozwala nagrać z sldprt rozwinięcie arkusza blachy w formacie dxf.

Sub main()

    Dim swApp As SldWorks.SldWorks
    Dim swmodel As SldWorks.ModelDoc2
    Dim stPath As String
    Dim lgFichier As Long
    Dim blretval As Boolean
    
    Set swApp = Application.SldWorks

    'on récupére le document actif
    Set swmodel = swApp.ActiveDoc
    
    If Not swmodel Is Nothing Then
       'on vérifie que le fichier est enregisté
        If swmodel.GetPathName = "" Then
            MsgBox "Veuillez enregistrer votre document avant de lancer la macro", vbInformation
            End
        Else
            'on récupére l'emplacement du fichier
            stPath = swmodel.GetPathName

            'on récupére le nombre de caractére jusqu'au . de l'extension
            lgFichier = InStrRev(stPath, ".", -1, vbTextCompare) - 1
            'on récupére le chemin sans l'extention
            If lgFichier > 0 Then
                  stPath = Left(stPath, lgFichier)
            End If
        End If
        
        'si le document est une pièce
        If swmodel.GetType = swDocPART Then
           'on créer le déplié
            blretval = swmodel.ExportFlatPatternView(stPath & ".DXF", 1)
            'on créer le DXF
            blretval = swmodel.SaveAs3(stPath & ".DXF", 0, 0)
        End If
    End If

End Sub

 

Nadal musisz napisać kod dla części analitycznej folderu, załadować część, a następnie zamknąć tę część.

Pozdrowienia

2 polubienia

Dziękuję za pomoc,

Mój program teraz działa! Otwiera się, zapisuje plik dxf i zamyka wszystkie części w wybranym folderze.

Dzielę się

 

 

'-------------------------------------------------------------------------------------------------------------


Opcja jawna

Prywatny Const BIF_RETURNONLYFSDIRS Tak długi = &H1
Prywatny Const BIF_DONTGOBELOWDOMAIN Tak długo = &H2
Prywatny Const BIF_RETURNFSANCESTORS Tak długo = &H8
Prywatny Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Prywatny Const BIF_BROWSEFORPRINTER Tak długi = &H2000
Prywatny Const BIF_BROWSEINCLUDEFILES Tak długi = &H4000
Prywatny Const MAX_PATH Tak długo = 260

Funkcja BrowseFolder(opcjonalny podpis jako ciąg, opcjonalny folder początkowy jako ciąg) jako ciąg

Dim SH As Shell32.Shell
Dim F As Shell32.Folder

Ustaw SH = New Shell32.Shell
Ustaw F = SH. BrowseforFolder(0&; Podpis, BIF_RETURNONLYFSDIRS, Folder_początkowy)
Jeśli nie, F jest niczym, to
    Jeśli F = "Pulpit", to
        BrowseFolder = Informacje("PROFIL UŻYTKOWNIKA") & "\Pulpit"
    Inaczej
        BrowseFolder = F.Items.Item.Path
    Zakończ jeżeli:
Zakończ jeżeli:

Zakończ funkcję

Sub main()
Dim swApp        jako SldWorks.SldWorks
Przyciemnij swmodel      jako SldWorks.ModelDoc
Dim sFileName    As Ciąg
Przyciemnij ścieżkę         jako ciąg
Dim nErrors      tak długo, jak długo
Dim nWarnings tak długo,    jak długo
Przyciemnij swPart       jako SldWorks.PartDoc
Dim PartNoDes    As String
Dim stPath As String
Dim lgFile tak długo
Dim blretval As Boolean


    Ustaw swApp = Application.SldWorks
   ' Ustaw swExportPDFData = swApp.GetExportFileData(1)
  
    
    Path = BrowseFolder("Wybierz ścieżkę/folder")
    Jeśli ścieżka = "" to
        MsgBox "Proszę wybrać ścieżkę i spróbować ponownie"
        Koniec
    Inaczej
    Ścieżka = Ścieżka + "\"
    Zakończ jeżeli:
         
    sFileName = Dir(Ścieżka & "*.sldprt")
    Rób, aż sFileName = ""
        Set swmodel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
        Ustaw swmodel = swApp.ActiveDoc
        Ustaw swPart = swApp.ActiveDoc
           
                   Jeśli swmodel. GetPathName = "" Następnie
            MsgBox "Proszę zapisać dokument przed uruchomieniem makra", vbInformation
            Koniec
        Inaczej
            "Otrzymujemy lokalizację pliku
            stPath = swmodel. GetPathName (Nazwa_ścieżki)

            "Zwiększamy liczbę znaków do . rozszerzenia
            lgFile = InStrRev(stPath, ".", -1, vbTextCompare) - 1
            "Odzyskujemy ścieżkę bez przedłużenia
            Jeśli lgFile > 0, to
                  stPath = Lewo(stPath, lgFile)
            Zakończ jeżeli:
        Zakończ jeżeli:
        
        "Jeżeli dokument jest dokumentem
        Jeśli swmodel. GetType = swDocPART Następnie
           "Tworzymy to, co rozłożone
            blretval = swmodel. ExportFlatPatternView(stPath & ". DXF", 1)
            Powstał plik DXF
            blretval = swmodel. SaveAs3(stPath & ". DXF", 0, 0)
        Zakończ jeżeli:
           
             swApp.QuitDoc swPart.GetPathName
        Ustaw swPart = Nic
        Set swmodel = Nic
        sFileName = Katalog
    Pętla

MsgBox "Wszystko gotowe"
Koniec subwoofera

'-------------------------------------------------------------------------------------------------------------

4 polubienia