Bearbeiten von PDF/DWG-STEP Makro-Code

Antoine_Ruelle · 28. November 2023 um 09:53

Hallo ihr alle

Ich verwende ein einfaches Makro, um meine Zeichnungen in PDF/DWG zu speichern, die ich aus dem Internet erhalten habe. Ich möchte es in 2 Punkten weiterentwickeln:

Speichern Sie PDFs in einem PDF-Unterordner und das Gleiche für DWGs in meinem Zeichnungsordner
Ich möchte in der Lage sein, den Teil meiner Zeichnung zu öffnen und STEP zu erstellen, der in einem Unterordner meines Teileordners gespeichert wird.

Ich bin neu bei SW-Makros und ich bin ein bisschen verloren, wenn mir jemand helfen kann

Hier ist der Code:

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object

Sub main()
Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Path = Part.GetPathName 'Chemin du fichier

'Enregistrement PDF
Part.SaveAs2 Left(Path, (Len(Path) - 6)) & "PDF", 0, True, False '

'Enregistrement DWG
Part.SaveAs2 Left(Path, (Len(Path) - 6)) & "DWG", 0, True, False '

MsgBox " Enregistrement réussi", vbInformation

Set Part = Nothing

End Sub

sbadenis · 28. November 2023 um 10:40

Für ein äquivalentes Thema (dwg-pdf und step) siehe dieses: Das Makro von @Cyril.f ist funktional:

Das einzige, was Sie ändern müssen, wenn Sie damit zufrieden sind, ist das Hinzufügen von Ordnern. (pdf, dwg, Schritt)
"Es gibt mehrere Methoden, um dies zu tun, aber Sie müssen wissen:
1-Wenn Ihr Dateiname die gleiche Anzahl von Zeichen hat oder nicht, um den Ordnernamen abrufen zu können.
Und für den Schritt hier treten Sie nur auf ein Teil, wenn die Montage nicht funktioniert.

sbadenis · 28. November 2023 um 10:56

Dann, um Ihren Dateinamen, Ordner, zu manipulieren:

' PathName of current model document
Dim sModelFullPath As String
sModelFullPath = swModel.GetPathName

' get path name without filename
Dim sFilePath As String
sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))

' get filename and extension
Dim sFileName As String
sFileName = Right(sModelFullPath, Len(sModelFullPath) - InStrRev(sModelFullPath, "\"))

' get filename without extension
Dim sFileNameWithoutExtension As String
sFileNameWithoutExtension = Left(sFileName, InStrRev(sFileName, ".") - 1)

' combine everything to new path name
Dim sNewFullPath As String
sNewFullPath = prefix & sFileNameWithoutExtension & "REV" & CurrRev & ".pdf"

' SaveAs with new full path
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs sNewFullPath, 0, 0, swExportPDFData, 0, 0

Antoine_Ruelle · 28. November 2023 um 11:07

Vielen Dank für dieses Feedback, ich habe den Code getestet, aber er funktioniert nicht auf meinem PC, ich habe eine Nachricht, die mir mitteilt, dass ich einen undefinierten Block in Zeile 118 habe.

Die Dateien haben nicht die gleiche Anzahl von Zeichen, sie setzen sich wie folgt zusammen:
XXXX-XXXX-XXX-XXX - Bezeichnung

Was die Stufen betrifft, so suche ich nur nach Raumzeichnungen.

Wenn ich den folgenden Code richtig verstehe, muss ich dann den Pfad zum Speichern von Dateien in den verschiedenen Formaten hinzufügen?

sbadenis · 28. November 2023 um 12:41

Wahrscheinlich der Hinweis (Revision), den er nicht finden kann.
Und mit diesem Code:

Option Explicit

Public Enum swDocumentTypes_e
    swDocNONE = 0       ' Used to be TYPE_NONE

    swDocPART = 1       ' Used to be TYPE_PART

    swDocASSEMBLY = 2   ' Used to be TYPE_ASSEMBLY

    swDocDRAWING = 3    ' Used to be TYPE_DRAWING
End Enum
 
Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swDraw                      As SldWorks.DrawingDoc
Dim swView                      As SldWorks.View
Dim swConfig                    As SldWorks.Configuration

Dim vSheetNameArr               As Variant
Dim vSheetName                  As Variant

Dim I                           As Long
Dim nDocType                    As Long
Dim op                          As Long
Dim suppr                       As Long
Dim lErrors                     As Long
Dim lWarnings                   As Long

Dim boolstatus                  As Boolean
Dim bRet                        As Boolean
Dim FileConnu                   As Boolean

Dim nbConnu                     As Integer

Dim sModelName                  As String
Dim sPathName                   As String
Dim TabConnu(10000)             As String
Dim sConfigName                 As String
Dim sModelFullPath              As String
Dim sFilePath                   As String
Dim sFileName                   As String
Dim sFileNameWithoutExtension   As String

Sub main()



Set swApp = Application.SldWorks
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepAP, 214) 'Force la version AP214
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepExportPreference, swAcisOutputGeometryPreference_e.swAcisOutputAsSolidAndSurface) 'Force l'export en format Solid/Surface Geometry

Set swModel = swApp.ActiveDoc

' PathName of current model document
sModelFullPath = swModel.GetPathName

' get path name without filename
sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))

' get filename and extension
sFileName = Right(sModelFullPath, Len(sModelFullPath) - InStrRev(sModelFullPath, "\"))

' get filename without extension
sFileNameWithoutExtension = Left(sFileName, InStrRev(sFileName, ".") - 1)



Debug.Print sFilePath & "Pdf\" & sFileNameWithoutExtension & ".pdf"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Pdf\", vbDirectory) = vbNullString Then
    MkDir sFilePath & "Pdf\"
End If
swModel.Extension.SaveAs sFilePath & "Pdf\" & sFileNameWithoutExtension & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Dwg\", vbDirectory) = vbNullString Then
    MkDir sFilePath & "Dwg\"
End If
swModel.Extension.SaveAs sFilePath & "Dwg\" & sFileNameWithoutExtension & ".dwg", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Step\", vbDirectory) = vbNullString Then
    MkDir sFilePath & "Step\"
End If
Call ExportStep

End Sub
Sub ExportStep()
Set swDraw = swModel
vSheetName = swDraw.GetSheetNames
vSheetNameArr = swDraw.GetSheetNames

For Each vSheetName In vSheetNameArr
        
    bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
    Set swView = swDraw.GetFirstView 'Sélectionne le fond de plan
    Set swView = swView.GetNextView  'Passe à la vue suivante pour exclure le fond de plan
                
    While Not swView Is Nothing
           
        ' Determine if this is a view of a part or assembly

        sModelName = swView.GetReferencedModelName

        sModelName = LCase(sModelName)
                        
        sConfigName = swView.ReferencedConfiguration
        
        FileConnu = False
        
        If InStr(sModelName, "sldprt") > 0 Then
            nDocType = swDocPART
        ElseIf InStr(sModelName, "slasm") > 0 Then
            nDocType = swDocASSEMBLY
        Else
            nDocType = swDocNONE
            Exit Sub
        End If
                       
        If nDocType = 1 Then
            For I = 1 To nbConnu
                If UCase(sModelName) & " - " & UCase(sConfigName) = TabConnu(I) Then
                    FileConnu = True
                End If
            Next
            If Not FileConnu Then
                nbConnu = nbConnu + 1
                TabConnu(nbConnu) = UCase(sModelName) & " - " & UCase(sConfigName)
                Call Export
            End If
        End If
        
        Set swView = swView.GetNextView
    Wend

Next vSheetName



End Sub
Sub Export()
Set swModel = swApp.ActivateDoc3(sModelName, True, swOpenDocOptions_Silent, lErrors)
Set swModel = swApp.ActiveDoc
boolstatus = swModel.ShowConfiguration2(sConfigName)
Set swConfig = swModel.GetActiveConfiguration
sPathName = sFilePath & "Step\" & sFileNameWithoutExtension & ".step"
'sPathName = swModel.GetPathName & ".step"
If Dir(sPathName, vbHidden) <> "" Then              'Test l'existence du fichier
    suppr = MsgBox("Le fichier " & sPathName & " existe déjà, voulez vous le supprimer?", vbYesNo) 'Message utilisateur confirmation de suppression oui/non
        If suppr = vbYes Then                       'Réponse Oui
            Kill (sPathName) 'Suppression du fichier existant
            swModel.SaveAs2 sPathName, 0, True, False  'Enregistrement du fichier
            op = MsgBox("Le fichier a été enregistré sous " & sPathName & vbNewLine)
            Else                                    'Réponse NON
        MsgBox ("Fichier conservé")                 'Message utilisateur
        End If
        Else
        swModel.SaveAs2 sPathName, 0, True, False      'Enregistrement du fichier
        op = MsgBox("Le fichier a été enregistré sous " & sPathName) 'Message utilisateur
    End If
swApp.CloseDoc (sModelName)
Set swModel = swApp.ActiveDoc
End Sub

Antoine_Ruelle · 28. November 2023 um 12:46

Ich habe es gerade getestet, aber ich bekomme immer noch die gleiche Nachricht

sbadenis · 28. November 2023 um 12:50

Starten Sie das Makro aus einer Zeichnung heraus?

Antoine_Ruelle · 28. November 2023 um 12:52

Ja, ich habe eine Grundzeichnung eines Blechteils erstellt.

sbadenis · 28. November 2023 um 12:53

Hast du es auch aufgenommen? (wenn nicht registriert, kann der Name nicht gefunden werden)

Antoine_Ruelle · 28. November 2023 um 12:55

Ja, es ist gut aufgenommen!
es funktioniert mit meinem kleinen Makro, ich kann PDF/DWG machen

sbadenis · 28. November 2023 um 12:57

Haben die Zeichnungen und die Räume den gleichen Namen? (ausgenommen Erweiterungen)

sbadenis · 28. November 2023 um 12:59

Wenn Sie in Version < oder = bis 2020 sind, können Sie auch einen Plan + Teil anhängen, wenn Sie möchten.
Ich reproduziere das Problem nicht.

Antoine_Ruelle · 28. November 2023 um 13:03

Ja, denn wenn ich die Zeichnung speichere, nimmt sie den Namen des Raumes ein!
Hier sind die Dateien (ich bin in der Version 2022)
TMS-64300-003-PDM - Cap.SLDDRW (183.1 KB)
TMS-64300-003-PDM - Kap.SLDPRT (111.7 KB)

sbadenis · 28. November 2023 um 13:08

Wenn ich kann, werde ich einen PC mit dem 2023 zum Testen öffnen, aber das ist vorerst nicht möglich.
Prüfen Sie, ob Sie den Aufruf ExportStep bereits löschen, wenn das PDF und das DWG zu Beginn gut gemacht sind.

Antoine_Ruelle · 28. November 2023 um 13:15

Es ist in Ordnung, ich habe das PDF und das DWG in derselben Datei wie der SW-Plan. In der Tat funktioniert es durch Entfernen des ExportStep-Aufrufs

sbadenis · 28. November 2023 um 13:19

Ich habe auf SW2023 getestet, die 3 Dateien werden zu mir nach Hause exportiert.
Es kommt also nicht vom Dateinamen. Sind Ihre Dateien lokal oder in Netzwerken?
Keine Sonderzeichen in Ihrem Dateipfad?
Versuchen Sie beispielsweise, nach C:\Temp\YourFiles zu kopieren, um zu sehen, ob es funktioniert

Antoine_Ruelle · 28. November 2023 um 13:26

Okay, ich habe nur PDF/DWG

Die Dateien befinden sich in Netzwerken und nein, es gibt keine Sonderzeichen im Pfad

sbadenis · 28. November 2023 um 13:28

Der ExportStep-Aufruf muss zurückgestellt werden.
Und testen Sie auf dem Laufwerk C mit einem einfachen Pfad zu sehen.

Antoine_Ruelle · 28. November 2023 um 13:37

Ich habe den Test gemacht, indem ich es auf meinen Schreibtisch gelegt habe und es hat nicht funktioniert und das Gleiche gilt für den C, ich habe die gleiche Nachricht wie am Anfang.

Ich gebe zu, dass ich mich verlaufen habe...

sbadenis · 28. November 2023 um 14:00

Ich trockne auch!
Können Sie das Makro bearbeiten, die Fenster "Ausführung" und "Lokale Variablen" hinzufügen (siehe Bild), dann direkt nach Sub main() klicken und F8 drücken, damit es Fehler macht?

Grundsätzlich wird das Makro Schritt für Schritt zerrissen. Und überprüfen Sie im lokalen Variablenfenster den Wert von sModelName, wenn es abstürzt:

Und auch, wenn swModel leer bleibt.