Edycja kodu makra PDF/DWG-STEP

Antoine_Ruelle · 28 Listopad 2023 09:53

Cze wszystkim

Używam podstawowego makra do zapisywania rysunków w formacie PDF/DWG, które otrzymałem z Internetu. Chciałbym, aby ewoluował w 2 punktach:

Przechowuj pliki PDF w podfolderze PDF i tak samo jak w przypadku plików DWG, w folderze Rysunek
Chciałbym mieć możliwość otwarcia części mojego rysunku i utworzenia STEP, który zostanie zapisany w podfolderze mojego folderu części.

Jestem nowy w makrach SW i jestem trochę zagubiony, jeśli ktoś może mi pomóc

Oto kod:

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 Listopad 2023 10:40

Równoważny temat (dwg-pdf i krok) można znaleźć w tym: Makro @Cyril_f jest funkcjonalne:

Jedyną rzeczą, którą należy zmienić, jeśli jesteś z tego zadowolony, będzie dodanie folderów. (pdf, dwg, krok)
Można to zrobić na kilka sposobów, ale musisz wiedzieć:
1-Jeśli nazwa pliku ma taką samą liczbę znaków, czy nie, aby móc pobrać nazwę folderu.
A w przypadku tego kroku nadepnij na część tylko wtedy, gdy montaż nie zadziała.

sbadenis · 28 Listopad 2023 10:56

Następnie, aby manipulować nazwą pliku, folder:

' 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 Listopad 2023 11:07

Dziękuję za tę opinię, przetestowałem kod, ale nie działa na moim komputerze, mam komunikat, który informuje mnie, że mam niezdefiniowany blok w linii 118.

Jeśli chodzi o pliki, nie mają one takiej samej liczby znaków, są one zbudowane w następujący sposób:
XXXX-XXXX-XXX-XXX - Oznaczenie

Jeśli chodzi o kroki, szukam tylko rysunków pomieszczeń.

Jeśli dobrze rozumiem poniższy kod, czy ma on na celu dodanie ścieżki do zapisywania plików w różnych formatach?

sbadenis · 28 Listopad 2023 12:41

Prawdopodobnie wskazówka (Rewizja), której nie może znaleźć.
A z tym kodem:

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 Listopad 2023 12:46

Właśnie go przetestowałem, ale nadal otrzymuję ten sam komunikat

sbadenis · 28 Listopad 2023 12:50

Czy uruchamiasz makro z rysunku?

Antoine_Ruelle · 28 Listopad 2023 12:52

Tak, utworzyłem podstawowy rysunek części arkusza blachy

sbadenis · 28 Listopad 2023 12:53

Czy Ty też to nagrałeś? (jeśli nie jest zarejestrowany, nie mogę znaleźć nazwy)

Antoine_Ruelle · 28 Listopad 2023 12:55

Tak, jest dobrze nagrany!
działa z moim małym makrem, mogę zrobić PDF/DWG

sbadenis · 28 Listopad 2023 12:57

Czy rysunki i pokoje mają tę samą nazwę? (bez rozszerzeń)

sbadenis · 28 Listopad 2023 12:59

Jeśli jesteś w wersji < lub = do 2020 roku możesz również dołączyć plan + część, jeśli chcesz.
Nie odtwarzam problemu.

Antoine_Ruelle · 28 Listopad 2023 13:03

Tak, ponieważ kiedy zapisuję rysunek, zajmuje on nazwę pokoju!
Oto pliki (jestem w wersji z 2022 roku)
TMS-64300-003-PDM - Czapka SLDDRW (183.1 KB)
TMS-64300-003-PDM - Czapka SLDPRT (111.7 KB)

sbadenis · 28 Listopad 2023 13:08

Jeśli będę mógł, otworzę komputer z 2023 rokiem do przetestowania, ale na razie nie jest to możliwe.
Sprawdź, czy usunąłeś już wywołanie ExportStep, jeśli plik PDF i dwg są dobrze zrobione na początek.

Antoine_Ruelle · 28 Listopad 2023 13:15

W porządku, mam PDF i DWG w tym samym pliku co plan oprogramowania. Rzeczywiście, usuwając wywołanie ExportStep, działa to

sbadenis · 28 Listopad 2023 13:19

Przetestowałem na SW2023, 3 pliki są eksportowane do mojego domu.
Więc nie pochodzi z nazwy pliku. Czy Twoje pliki są lokalne czy w sieci?
Brak znaków specjalnych w ścieżce do pliku?
Spróbuj skopiować na przykład do C:\Temp\YourFiles, aby sprawdzić, czy to działa

Antoine_Ruelle · 28 Listopad 2023 13:26

Okej, mam tylko PDF/DWG

pliki znajdują się w sieciach i nie, w ścieżce nie ma żadnych znaków specjalnych

sbadenis · 28 Listopad 2023 13:28

Wywołanie ExportStep musi zostać odłożone z powrotem.
I przetestuj na dysku C z prostą ścieżką, którą można zobaczyć.

Antoine_Ruelle · 28 Listopad 2023 13:37

Zrobiłem test kładąc go na biurku i nie zadziałało i tak samo na C mam ten sam komunikat co na początku.

Przyznaję, że jestem zagubiony...

sbadenis · 28 Listopad 2023 14:00

Ja też suszę!
Czy możesz edytować makro, dodać okna Wykonywanie i Zmienne lokalne (patrz obrazek), a następnie kliknąć zaraz po Sub main() i nacisnąć F8 tylko po to, aby to spowodowało błędy?

Zasadniczo rozerwij makro krok po kroku. I sprawdź w oknie zmiennej lokalnej wartość sModelName, gdy się zawiesza:

A także jeśli swModel pozostaje pusty.