Zapis makr wszystkich mep w formacie PDF z indeksem części

Cyril_f · 27 Marzec 2023 13:02

Witam

Czy na pewno chcesz zacząć od złożenia, aby pobrać rysunki lub przetwarzanie w folderze ze wszystkimi rysunkami, które się tam znajdują?

_Cricri · 27 Marzec 2023 13:12

Witaj Cyril.f
Te 2 rozwiązania są dla mnie w porządku, ale zaczynając od montażu, można zrobić tylko jego plany, co jest najłatwiejsze?

_Cricri · 27 Marzec 2023 13:13

Dziękuję

Cyril_f · 27 Marzec 2023 13:26

Wszystko jest do zrobienia, po prostu istnieją już makra, które radzą sobie z folderu.

_Cricri · 27 Marzec 2023 13:47

Wolałbym zacząć od montażu tak jak w pierwszym makrze wspomnianym "pdf_des_compsants_de_lassemblage"

Cyril_f · 28 Marzec 2023 05:24

Witam
Oto kod z dwóch makr. Nie dodałem kontrolki w przypadku braku właściwości "REVISION", jeśli z drugiej strony połączenie między planem a 3D jest zerwane lub nie ma dołączonego modelu, makro idzie swoją drogą bez tworzenia PDF (można to zmienić, przesuwając End if).
Nie dodałem również sprawdzania, czy plik PDF istnieje (i związane z tym przetwarzanie)

' Description:
' Traverses the open assembly and activates all components and their drawings (if of the
' same name).
Option Explicit

Dim fso                 As Scripting.FileSystemObject
Dim swApp               As SldWorks.SldWorks
Dim myDwgDoc            As SldWorks.ModelDoc2
Dim swDoc               As SldWorks.ModelDoc2
Dim FirstDoc            As SldWorks.ModelDoc2
Dim swRefDoc            As SldWorks.ModelDoc2
Dim Part                As SldWorks.ModelDoc2
Dim swDraw              As SldWorks.DrawingDoc
Dim swExportPDFData     As SldWorks.ExportPdfData
Dim swView              As SldWorks.View
Dim swAllDocs           As EnumDocuments2
Dim NumDocsReturned     As Long
Dim DocCount            As Long
Dim i                   As Long
Dim OpenWarnings        As Long
Dim OpenErrors          As Long
Dim lErrors             As Long
Dim lWarnings           As Long
Dim dummy               As Boolean
Dim bDocWasVisible      As Boolean
Dim boolstatus          As Boolean
Dim sMsg                As String
Dim DwgPath             As String
Dim drwPathName         As String
Dim pdfPathName         As String
Dim pdfFolderName       As String
Dim revision            As String
Sub ShowAllOpenFiles()

Set swApp = Application.SldWorks
Set swAllDocs = swApp.EnumDocuments2
Set FirstDoc = swApp.ActiveDoc
   
DocCount = 0
swAllDocs.Reset
swAllDocs.Next 1, swDoc, NumDocsReturned
While NumDocsReturned <> 0
    bDocWasVisible = swDoc.Visible
    'swApp.ActivateDoc swDoc.GetPathName'
    DwgPath = swDoc.GetPathName
    If (LCase(Right(DwgPath, 3)) <> "drw") And (DwgPath <> "") Then
        DwgPath = Left(DwgPath, Len(DwgPath) - 3) & "drw"
        Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)
        If Not myDwgDoc Is Nothing Then
            swApp.ActivateDoc myDwgDoc.GetPathName
 
pdfFolderName = "C:\pdf files\"

 

Set fso = CreateObject("Scripting.FileSystemObject")
 
If (Not fso.FolderExists(pdfFolderName)) Then
MkDir pdfFolderName
'MsgBox (pdfFolderName + " does not exist")
'Exit Sub
End If
 


Set Part = swApp.ActiveDoc()
Set swDraw = Part

Set swView = swDraw.GetFirstView 'active/récupère le fond de plan pour les propri perso

Set swView = swView.GetNextView 'active/récupère la première vue pour les propri perso

Set swRefDoc = swView.ReferencedDocument  ' On a maintenant swRefDoc le 3D de la mise en plan

If Not swRefDoc Is Nothing Then 'Vérification si fichier rattaché à la vue existe (lien rompu par exemple)

    revision = swRefDoc.GetCustomInfoValue("", "REVISION") ' on récupère la propriété revision


    'You have a drawing active
    drwPathName = Part.GetPathName()
 
    If ("" = drwPathName) Then
        ' GetPathName() was empty
        MsgBox ("This drawing has not been saved yet")
        Exit Sub
    End If
 
    pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) + revision + ".pdf")
    Debug.Print pdfPathName
    Set swExportPDFData = swApp.GetExportFileData(1)
    swExportPDFData.ViewPdfAfterSaving = False
    Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings
End If 'Déplacer ce End If juste après revision = swRefDoc.GetCustomInfoValue("", "REVISION")  si le pdf doit tout de même être généré
'MsgBox ("PDF file was created")
    swApp.QuitDoc (Part.GetTitle)
            Set myDwgDoc = Nothing
            Set swRefDoc = Nothing
            Set Part = Nothing
            Set swDraw = Nothing
        End If
    End If
    swAllDocs.Next 1, swDoc, NumDocsReturned
    DocCount = DocCount + 1
Wend
 
swApp.ActivateDoc FirstDoc.GetPathName

Set FirstDoc = Nothing
Set swApp = Nothing
 
End Sub

_Cricri · 28 Marzec 2023 05:51

Witam
DZIĘKUJĘ Cyril.f działa bardzo dobrze.
Jeszcze jedno, lubię mieć myślnik między nazwą a wskazówką.
Przykład: imię-AA
Spojrzałem trochę na twoje makro, ale nie będę w stanie powiedzieć ani dodać "-"

Cyril_f · 28 Marzec 2023 05:57

Musisz zmienić tę linię:

Przez:

pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) + "-" +  revision + ".pdf")

_Cricri · 28 Marzec 2023 06:01

To jest rzeczywiście linia, w której dodałem - ale nie umieściłem " "
Dziękuję Cyril.f

_Cricri · 28 Marzec 2023 06:40

Jeszcze jedno, czy istnieje sposób, aby zrobić dxf w tym samym czasie?

Cyril_f · 28 Marzec 2023 06:46

Tak, ale z prostego dxf planu czy w przypadku blachy ze spłaszczeniem?

_Cricri · 28 Marzec 2023 07:10

Tak, prosty dxf planu

Cyril_f · 28 Marzec 2023 07:23

Oto pełny kod:

' Description:
' Traverses the open assembly and activates all components and their drawings (if of the
' same name).
Option Explicit

Dim fso                 As Scripting.FileSystemObject
Dim swApp               As SldWorks.SldWorks
Dim myDwgDoc            As SldWorks.ModelDoc2
Dim swDoc               As SldWorks.ModelDoc2
Dim FirstDoc            As SldWorks.ModelDoc2
Dim swRefDoc            As SldWorks.ModelDoc2
Dim Part                As SldWorks.ModelDoc2
Dim swDraw              As SldWorks.DrawingDoc
Dim swExportPDFData     As SldWorks.ExportPdfData
Dim swView              As SldWorks.View
Dim swAllDocs           As EnumDocuments2
Dim NumDocsReturned     As Long
Dim DocCount            As Long
Dim i                   As Long
Dim OpenWarnings        As Long
Dim OpenErrors          As Long
Dim lErrors             As Long
Dim lWarnings           As Long
Dim dummy               As Boolean
Dim bDocWasVisible      As Boolean
Dim boolstatus          As Boolean
Dim sMsg                As String
Dim DwgPath             As String
Dim drwPathName         As String
Dim pdfPathName         As String
Dim pdfFolderName       As String
Dim dxfPathName         As String
Dim revision            As String
Sub ShowAllOpenFiles()

Set swApp = Application.SldWorks
Set swAllDocs = swApp.EnumDocuments2
Set FirstDoc = swApp.ActiveDoc
   
DocCount = 0
swAllDocs.Reset
swAllDocs.Next 1, swDoc, NumDocsReturned
While NumDocsReturned <> 0
    bDocWasVisible = swDoc.Visible
    'swApp.ActivateDoc swDoc.GetPathName'
    DwgPath = swDoc.GetPathName
    If (LCase(Right(DwgPath, 3)) <> "drw") And (DwgPath <> "") Then
        DwgPath = Left(DwgPath, Len(DwgPath) - 3) & "drw"
        Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)
        If Not myDwgDoc Is Nothing Then
            swApp.ActivateDoc myDwgDoc.GetPathName
 
pdfFolderName = "C:\pdf files\"

 

Set fso = CreateObject("Scripting.FileSystemObject")
 
If (Not fso.FolderExists(pdfFolderName)) Then
MkDir pdfFolderName
'MsgBox (pdfFolderName + " does not exist")
'Exit Sub
End If
 


Set Part = swApp.ActiveDoc()
Set swDraw = Part

Set swView = swDraw.GetFirstView 'active/récupère le fond de plan pour les propri perso

Set swView = swView.GetNextView 'active/récupère la première vue pour les propri perso

Set swRefDoc = swView.ReferencedDocument  ' On a maintenant swRefDoc le 3D de la mise en plan

If Not swRefDoc Is Nothing Then 'Vérification si fichier rattaché à la vue existe (lien rompu par exemple)

    revision = swRefDoc.GetCustomInfoValue("", "REVISION") ' on récupère la propriété revision


    'You have a drawing active
    drwPathName = Part.GetPathName()
 
    If ("" = drwPathName) Then
        ' GetPathName() was empty
        MsgBox ("This drawing has not been saved yet")
        Exit Sub
    End If
 
    pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) & "-" & revision & ".pdf")
    dxfPathName = Left(pdfPathName, Len(pdfPathName) - 3) & "dxf"
    Debug.Print pdfPathName
    Set swExportPDFData = swApp.GetExportFileData(1)
    swExportPDFData.ViewPdfAfterSaving = False
    Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings
    boolstatus = Part.SaveAs4(dxfPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, lErrors, lWarnings)
End If 'Déplacer ce End If juste après revision = swRefDoc.GetCustomInfoValue("", "REVISION")  si le pdf doit tout de même être généré
'MsgBox ("PDF file was created")
    swApp.QuitDoc (Part.GetTitle)
            Set myDwgDoc = Nothing
            Set swRefDoc = Nothing
            Set Part = Nothing
            Set swDraw = Nothing
        End If
    End If
    swAllDocs.Next 1, swDoc, NumDocsReturned
    DocCount = DocCount + 1
Wend
 
swApp.ActivateDoc FirstDoc.GetPathName

Set FirstDoc = Nothing
Set swApp = Nothing
 
End Sub

Nie sprawdzałem ustawień eksportu.

_Cricri · 28 Marzec 2023 08:42

Dziękuję Cyril.f
Nie mogę znaleźć, gdzie . Za indeksem dla planów DXF
Zasadniczo mam imię AA. Dla plików DXF

A_R · 28 Marzec 2023 08:48

Bonjour_cricri,
Dla informacji, jeśli masz dostęp do narzędzi " MycadTools ", używasz "BatchConverter".

Ta aplikacja jest do tego stworzona...
Powodzenia.
@+.
AR.

Cyril_f · 28 Marzec 2023 08:57

Przepraszam, słabo zintegrowane.
Musimy zmienić linię

dxfPathName = Left(pdfPathName, Len(pdfPathName) - 3)& ".dxf"

Przez:

dxfPathName = Left(pdfPathName, Len(pdfPathName) - 3)& "dxf"

_Cricri · 28 Marzec 2023 09:02

Witaj AR
Niestety nie mam dostępu do narzędzia do konwersji wsadowej

_Cricri · 28 Marzec 2023 09:06

Nie musisz mówić przepraszam Cyril.f , już bardzo się cieszę, że mam twoją pomoc.
Makro działa BARDZO DOBRZE, zmieni życie moich nowych kolegów.
Na solidworks jestem dopiero od 3 miesięcy, ale mam za sobą 25 lat Creo.

A_R · 28 Marzec 2023 10:01

ok, tak właśnie myślałem...
Powodzenia!!!
@+.
AR.

m_blt · 28 Marzec 2023 10:18

Witaj @_Cricri ,

Inne podejście niż w przypadku @Cyril_f , wywodzące się z makra z witryny www.codestack.net.
To makro służy do eksportowania rysunków komponentów zespołu do podfolderów w katalogu głównym zespołu:

w formacie PDF w podfolderze pdf_files ;
DXF w podfolderze dxf_files
w formacie DWG w podfolderze dwg_files.

Dla każdego komponentu rysunki są przeszukiwane w jego folderze kopii zapasowej i podfolderach i niekoniecznie mają taką samą nazwę jak model 3D.
W zasadzie zatem do przetestowania...

Pozdrowienia.
AssyCompsMEPsaveAsPdfDxfDwg.swp (107.5 KB)