Macro-opname van alle Europarlementariërs in PDF met onderdelenindex

Cyril_f · 27 maart 2023 om 13:02

Hallo

Wil je absoluut beginnen vanuit een assemblage om de tekeningen of verwerking in een map op te halen van alle tekeningen die er zijn?

_Cricri · 27 maart 2023 om 13:12

Hallo Cyril.f
De 2 oplossingen vind ik prima, maar als je begint met een montage, kun je er alleen de plannen van maken, wat is het gemakkelijkst?

_Cricri · 27 maart 2023 om 13:13

Bedankt

Cyril_f · 27 maart 2023 om 13:26

Alles is mogelijk, het is alleen dat er al bestaande macro's zijn die vanuit een map handelen.

_Cricri · 27 maart 2023 om 13:47

Ik zou er de voorkeur aan geven om te beginnen met de montage zoals in de eerste macro die "pdf_des_compsants_de_lassemblage" wordt genoemd

Cyril_f · 28 maart 2023 om 05:24

Hallo
Hier is de code van de twee macro's. Ik heb geen besturingselement toegevoegd in geval van afwezigheid van de eigenschap "REVISIE", als aan de andere kant de link tussen het plan en de 3D is verbroken of als er geen model is bijgevoegd, gaat de macro zijn weg zonder de PDF te maken (dit kan worden gewijzigd door het einde te verplaatsen als).
Ik heb ook geen controle toegevoegd of het PDF-bestand al dan niet bestaat (en de bijbehorende verwerking)

' 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 maart 2023 om 05:51

Hallo
BEDANKT Cyril.f het werkt heel goed.
Nog één ding, ik vind het leuk om een streepje tussen de naam en de aanwijzing te hebben.
Voorbeeld: naam-AA
Ik keek naar je macro een beetje, maar ik zal niet in staat zijn om te zeggen of toe te voegen "-"

Cyril_f · 28 maart 2023 om 05:57

Je moet deze regel veranderen:

Bij:

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

_Cricri · 28 maart 2023 om 06:01

Dit is inderdaad de regel waar ik de - had toegevoegd, maar ik had de " " niet geplaatst
Dank je wel Cyril.f

_Cricri · 28 maart 2023 om 06:40

Nog een ding, is er een manier om de dxf te doen op hetzelfde moment?

Cyril_f · 28 maart 2023 om 06:46

Ja, maar uit de eenvoudige dxf van het plan of in het geval van plaatwerk met een afvlakking?

_Cricri · 28 maart 2023 om 07:10

Ja, een eenvoudige dxf van plan

Cyril_f · 28 maart 2023 om 07:23

Hier is de volledige code:

' 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

Ik heb de exportinstellingen niet gecontroleerd.

_Cricri · 28 maart 2023 om 08:42

Dank je wel Cyril.f
Ik kan niet vinden waar de . Achter de index voor DXF-plannen
Kortom, ik heb naam-AA. Voor DXF's

A_R · 28 maart 2023 om 08:48

Bonjour_cricri,
Ter informatie, als u toegang heeft tot de " MycadTools " -tools, gebruikt u "BatchConverter".

Daar is deze app voor gemaakt...
Succes.
@+.
AR.

Cyril_f · 28 maart 2023 om 08:57

Sorry, slecht geïntegreerd.
We moeten de lijn veranderen

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

Bij:

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

_Cricri · 28 maart 2023 om 09:02

Hallo AR
Helaas heb ik geen toegang tot de Batch converter tool

_Cricri · 28 maart 2023 om 09:06

Je hoeft geen sorry te zeggen Cyril.f, ik ben al super blij met je hulp.
De macro werkt HEEL GOED, het zal het leven van mijn nieuwe collega's veranderen.
Ik zit amper 3 maanden op solidworks, maar ik heb 25 jaar Creo achter de rug.

A_R · 28 maart 2023 om 10:01

ok dat is wat ik dacht ...
Succes!!!
@+.
AR.

m_blt · 28 maart 2023 om 10:18

Hallo @_Cricri ,

Een andere aanpak dan die van @Cyril_f , afgeleid van een macro van de www.codestack.net site.
Gebruik deze macro om tekeningen van de componenten van een assembly te exporteren naar submappen in de hoofdmap van de assembly:

in PDF-formaat in een submap pdf_files ;
DXF in een submap dxf_files
in DWG-formaat in een submap dwg_files.

Voor elk onderdeel worden tekeningen doorzocht in de back-upmap en submappen en hebben ze niet noodzakelijkerwijs dezelfde naam als het 3D-model.
In principe dus te testen...

Vriendelijke groeten.
AssyCompsMEPsaveAsPdfDxfDwg.swp (107.5 KB)