Zróżnicowany eksport zakładek rysunków w formacie pdf i dxf za pomocą makra

fennec_flegmatique · 13 Lipiec 2021 05:18

Witam

Z powodzeniem używam dołączonego makra do eksportowania wszystkich zakładek na rysunku pdf jako osobnych plików.

Zajmuję się wielobryłowymi zespołami spawanymi, z których część wykonana jest z blachy.

Każda zakładka jest nazwana numerem elementu z listy części spawanych.

Podczas zapisywania makro dodaje nazwę pliku części jako prefiks, co idealnie mi odpowiada.

Z kolei części blaszane przeznaczone do cięcia laserowego są reprezentowane na dodatkowych zakładkach o nazwie "Cięcie" + Nr artykułu.

Chcę, aby zakładki zaczynające się od słowa "Cięcie" nie były zapisywane w pdf, ale w dxf z numerem artykułu bez prefiksu jako nazwy pliku.

Nie będąc ekspertem w programowaniu, czy użytkownik forum może mi pomóc?

Z podziękowaniami

pdf_page_par_page.swp

sbadenis · 13 Lipiec 2021 05:43

Łatwiej jest wyświetlić kod bezpośrednio niż dołączyć makro:

Const INCLUDE_DRAWING_NAME As Boolean = True

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
try_:
    
    On Error GoTo catch_
    
    Dim swDraw As SldWorks.DrawingDoc
    
    Set swDraw = swApp.ActiveDoc
    
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swDraw
        
    If swModel.GetPathName() = "" Then
        Err.Raise vbError, "", "Please save drawing"
    End If
        
    Dim vSheetNames As Variant
    
    Dim i As Integer
    
    Dim swSelMgr As SldWorks.SelectionMgr
    
    Set swSelMgr = swModel.SelectionManager
    
    Dim selSheetNames() As String
    
    For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
        
        If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelSHEETS Then
            
            If (Not selSheetNames) = -1 Then
                ReDim selSheetNames(0)
            Else
                ReDim Preserve selSheetNames(UBound(selSheetNames) + 1)
            End If
            Dim swSheet As SldWorks.Sheet
            Set swSheet = swSelMgr.GetSelectedObject6(i, -1)
            
            selSheetNames(UBound(selSheetNames)) = swSheet.GetName()
            
        End If
    Next
    
    If (Not selSheetNames) = -1 Then
        vSheetNames = swDraw.GetSheetNames
    Else
        vSheetNames = selSheetNames
    End If
    
    For i = 0 To UBound(vSheetNames)
        
        Dim sheetName As String
        sheetName = vSheetNames(i)
        
        Dim swExpPdfData As SldWorks.ExportPdfData
        Set swExpPdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)
        
        Dim errs As Long
        Dim warns As Long
        
        Dim expSheets(0) As String
        expSheets(0) = sheetName
        
        swExpPdfData.ExportAs3D = False
        swExpPdfData.ViewPdfAfterSaving = False
        swExpPdfData.SetSheets swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, expSheets
        
        Dim drawName As String
        drawName = swModel.GetPathName()
        drawName = Mid(drawName, InStrRev(drawName, "\") + 1, Len(drawName) - InStrRev(drawName, "\") - Len(".slddrw"))
        
        Dim outFile As String
        outFile = swModel.GetPathName()
        outFile = Left(outFile, InStrRev(outFile, "\"))
        Debug.Print outFile
        Debug.Print sheetName
        outFile = outFile & IIf(INCLUDE_DRAWING_NAME, drawName & "_", "") & sheetName & ".pdf"
        If False = swModel.Extension.SaveAs(outFile, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPdfData, errs, warns) Then
            Err.Raise vbError, "", "Failed to export PDF to " & outFile
        End If
        
    Next
    
    
    GoTo finally_
    
catch_:
    
    swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
    
finally_:
    
End Sub

Aby zrozumieć kod, wystarczy dodać debug.files i spojrzeć na okno wykonywania

Część, która Cię dotyczy:

outFile = Left(outFile, InStrRev(outFile, "\")) ' pobiera ścieżkę do rysunku

Widoczne za pomocą pliku debug.file "outFile" i outFile' wyświetlają c:\temp\

Wtedy:

outFile = outFile & IIf(INCLUDE_DRAWING_NAME, drawName & "_", "") & sheetName & ".pdf"

Ten wiersz definiuje nazwę pliku pdf, drawName pobiera nazwę pliku rysunku, a sheetName nazwę arkusza.

Ensuite         If False = swModel.Extension.SaveAs(outFile, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPdfData, errs, warns) Następnie
            Err.Raise vbError, "", "Nie udało się wyeksportować pliku PDF do " & outFile
        Zakończ jeżeli:

Wyeksportuj plik jako plik PDF lub wyświetl komunikat o błędzie.

Teraz musisz dodać warunek, jeśli arkusz sheetName zaczyna się od cięcia, otrzymujesz to, co pozostało z nazwy twojego arkusza i eksportujesz w formacie dwg zamiast pdf.

Wskazówka dotyczy funkcji VBA If, a także funkcji Split

fennec_flegmatique · 14 Lipiec 2021 11:29

Dziękuję Sbadenis za tę odpowiedź.

Przyjrzałem się funkcjom if i split, ale nie wiem, jak zintegrować je z kodem, aby uzyskać wynik, którego szukam...

fennec_flegmatique · 17 Lipiec 2021 09:41

Przepraszam, że do tego wracam, ale nie mogę się zabrać do tworzenia dxf

Jeśli możesz mi pomóc, z góry dziękuję

sbadenis · 19 Lipiec 2021 05:46

Posiadanie gotowego kodu jest dobre, ale zrozumienie go jest lepsze!

Ten kod powinien być funkcjonalny, nawet jeśli zrobiłem to w pośpiechu.

Dodałem if (warunek), aby sprawdzić, czy nazwa arkusza zaczyna się od cut, jeśli tak jest, eksportuję zakładkę z nazwą artykułu pobieram za pomocą funkcji mid (zamiast split).

Po kilku próbach i rozeznaniu w Internecie myślę, że mógłbyś to zrobić, wyświetlając swój kod w miarę postępów i uzyskując pomoc.

Const INCLUDE_DRAWING_NAME As Boolean = True

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
try_:
    
    On Error GoTo catch_
    
    Dim swDraw As SldWorks.DrawingDoc
    
    Set swDraw = swApp.ActiveDoc
    
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swDraw
        
    If swModel.GetPathName() = "" Then
        Err.Raise vbError, "", "Please save drawing"
    End If
        
    Dim vSheetNames As Variant
    
    Dim i As Integer
    
    Dim swSelMgr As SldWorks.SelectionMgr
    
    Set swSelMgr = swModel.SelectionManager
    
    Dim selSheetNames() As String
    
    For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
        
        If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelSHEETS Then
            
            If (Not selSheetNames) = -1 Then
                ReDim selSheetNames(0)
            Else
                ReDim Preserve selSheetNames(UBound(selSheetNames) + 1)
            End If
            Dim swSheet As SldWorks.Sheet
            Set swSheet = swSelMgr.GetSelectedObject6(i, -1)
            
            selSheetNames(UBound(selSheetNames)) = swSheet.GetName()
            
        End If
    Next
    
    If (Not selSheetNames) = -1 Then
        vSheetNames = swDraw.GetSheetNames
    Else
        vSheetNames = selSheetNames
    End If
    
    For i = 0 To UBound(vSheetNames)
        
        Dim sheetName As String
        sheetName = vSheetNames(i)
        
        Dim swExpPdfData As SldWorks.ExportPdfData
        Set swExpPdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)
        
        Dim errs As Long
        Dim warns As Long
        
        Dim expSheets(0) As String
        expSheets(0) = sheetName
        
        swExpPdfData.ExportAs3D = False
        swExpPdfData.ViewPdfAfterSaving = False
        swExpPdfData.SetSheets swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, expSheets
        
        Dim drawName As String
        drawName = swModel.GetPathName()
        drawName = Mid(drawName, InStrRev(drawName, "\") + 1, Len(drawName) - InStrRev(drawName, "\") - Len(".slddrw"))
        
        Dim outFile As String
        outFile = swModel.GetPathName()
        outFile = Left(outFile, InStrRev(outFile, "\"))
        Debug.Print outFile
        Debug.Print sheetName
        
        If sheetName Like "Découpe*" Then 'Si Le nom de la feuille commence par Découpe, suivit de aucun ou plusieurs caractères
                Debug.Print "Fichier dxf à traiter"
                'Export en dxf à ajouter ici
                Debug.Print Mid(sheetName, 8)
                outFile = outFile & Mid(sheetName, 8) & ".dxf"
                Debug.Print "outfile=" & outFile
                If False = swModel.Extension.SaveAs(outFile, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPdfData, errs, warns) Then
                    Err.Raise vbError, "", "Failed to export dxf to " & outFile
                End If
        
        Else
            Debug.Print "Fichier pdf à traiter"
            outFile = outFile & IIf(INCLUDE_DRAWING_NAME, drawName & "_", "") & sheetName & ".pdf"
            If False = swModel.Extension.SaveAs(outFile, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPdfData, errs, warns) Then
                Err.Raise vbError, "", "Failed to export PDF to " & outFile
            End If
        
        End If

fennec_flegmatique · 9 Sierpień 2021 09:13

Witaj sbadenis

Przepraszam, że do tego wracam, szukałem w necie, próbowałem sam znaleźć m^meme, ale nic nie pomaga:

Część eksportu do formatu PDF działa świetnie w makrze poprzedniego posta

Część eksportu dxf eksportuje pliki o odpowiedniej nazwie, ale za każdym razem eksportowany jest pierwszy arkusz pliku rysunku, a nie strona cięcia

Czy możecie mi pomóc znaleźć rozwiązanie?

Z góry dziękuję

sbadenis · 16 Sierpień 2021 07:06

Czy możesz dołączyć przykładowy plik (część + MEP), aby zrozumieć?

Czy Twoja strona cięcia nadal znajduje się na 2. stronie, czy jest to losowe?

fennec_flegmatique · 16 Sierpień 2021 07:19

Witaj Sbadenis i dziękuję za wiadomość

W załączeniu znajduje się plik części i jej rysunek

Wszystkie moje szczegółowe plany moich zespołów spawanych są wykonane na tej samej zasadzie

Liczba zakładek jest losowa, czy to cięta, czy inna: zależy to od złożoności całości

Kiedyś miałem plan z 24 zakładkami...

Dziękuję za pomoc

A21-0616-D18.SLDDDRW
A21-0616-D18.SLDPRT

sbadenis · 16 Sierpień 2021 08:06

Spróbuj tego, właśnie dodałem opcję eksportu w dxf tylko aktywny arkusz i aktywuję arkusze cięcia jeden po drugim przed eksportem:

Const INCLUDE_DRAWING_NAME As Boolean = True

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
try_:
    
    On Error GoTo catch_
    
    Dim swDraw As SldWorks.DrawingDoc
    
    Set swDraw = swApp.ActiveDoc
    
    
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swDraw
        
    If swModel.GetPathName() = "" Then
        Err.Raise vbError, "", "Please save drawing"
    End If
        
    Dim vSheetNames As Variant
    
    Dim i As Integer
    
    Dim swSelMgr As SldWorks.SelectionMgr
    
    Set swSelMgr = swModel.SelectionManager
    
    Dim selSheetNames() As String
    
    For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
        
        If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelSHEETS Then
            
            If (Not selSheetNames) = -1 Then
                ReDim selSheetNames(0)
            Else
                ReDim Preserve selSheetNames(UBound(selSheetNames) + 1)
            End If
            Dim swSheet As SldWorks.Sheet
            Set swSheet = swSelMgr.GetSelectedObject6(i, -1)
            
            selSheetNames(UBound(selSheetNames)) = swSheet.GetName()
            
        End If
    Next
    
    If (Not selSheetNames) = -1 Then
        vSheetNames = swDraw.GetSheetNames
    Else
        vSheetNames = selSheetNames
    End If
    
    For i = 0 To UBound(vSheetNames)
        
        Dim sheetName As String
        sheetName = vSheetNames(i)
        
        Dim swExpPdfData As SldWorks.ExportPdfData
        Set swExpPdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)
        
        Dim errs As Long
        Dim warns As Long
        
        Dim expSheets(0) As String
        expSheets(0) = sheetName
        
        swExpPdfData.ExportAs3D = False
        swExpPdfData.ViewPdfAfterSaving = False
        swExpPdfData.SetSheets swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, expSheets
        
        Dim drawName As String
        drawName = swModel.GetPathName()
        drawName = Mid(drawName, InStrRev(drawName, "\") + 1, Len(drawName) - InStrRev(drawName, "\") - Len(".slddrw"))
        
        Dim outFile As String
        outFile = swModel.GetPathName()
        outFile = Left(outFile, InStrRev(outFile, "\"))
        Debug.Print outFile
        Debug.Print sheetName
        
        If sheetName Like "Découpe*" Then 'Si Le nom de la feuille commence par Découpe, suivit de aucun ou plusieurs caractères
                Debug.Print "Fichier dxf à traiter"
                'On active la feuille découpe
                Dim bRet As Boolean
                bRet = swDraw.ActivateSheet(sheetName)
                'Export en dxf à ajouter ici
                Debug.Print Mid(sheetName, 9)
                outFile = outFile & Mid(sheetName, 9) & ".dxf"
                Debug.Print "outfile=" & outFile
                
                'Option dxf
                intUserDWGSheetExport = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption)
                swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfActiveSheetOnly
                
                'swModel.Extension.SaveAs(outFile, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPdfData, errs, warns)
                If False = swModel.Extension.SaveAs(outFile, SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errs, warns) Then
                    Err.Raise vbError, "", "Failed to export dxf to " & outFile
                End If
                
                'on réinitialise les options.
                swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, intUserDWGSheetExport
                
        Else
            Debug.Print "Fichier pdf à traiter"
            outFile = outFile & IIf(INCLUDE_DRAWING_NAME, drawName & "_", "") & sheetName & ".pdf"
            If False = swModel.Extension.SaveAs(outFile, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExpPdfData, errs, warns) Then
                Err.Raise vbError, "", "Failed to export PDF to " & outFile
            End If
        
        End If
 Next
    
    
    GoTo finally_
    
catch_:
    
    swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
    
finally_:
    
End Sub

EDIT: i usuwam 9 znaków zamiast 8, aby wykluczyć również spację po wycięciu, która uniemożliwiała eksport (nazwa pliku nie może zaczynać się od spacji)