iLogic a ETO - Export do pdf s názvem listu

Vytisknout stránku | Zavřít okno

Export do pdf s názvem listu

Vytištěno z: CAD Fórum
Kategorie: Autodesk - stavebnictví, strojírenství, CAD/GIS
Název fóra: iLogic a ETO
Popis fóra: Funkce a makra iLogic, Inventor Engineering to Order (ETO), automatizace a konfigurace výrobků
URL: https://www.cadforum.cz/forum/forum_posts.asp?TID=34752
Datum vytištění: 04.čer.2026 v 18:10

Téma: Export do pdf s názvem listu

Odeslal: madep
Předmět: Export do pdf s názvem listu
Datum odeslání: 26.lis.2023 v 12:05

Dobrý den,
mám pravidlo na export z výkresu do PDF po jednom listu. Soubor se vždy uloží s názvem souboru IDW.
Potřebuji aby se uložil s názvem listu.
Děkuji za pomoc.

Sub Main PublishPDF()
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")

    ' a reference to the active document (the document to be published).
    Dim oDocument As Document
     oDocument = ThisApplication.ActiveDocument

    Dim oContext As TranslationContext
     oContext = ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism

    ' Create a NameValueMap object
    Dim oOptions As NameValueMap
     oOptions = ThisApplication.TransientObjects.CreateNameValueMap

    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
     oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

      oOptions.Value("Sheet_Range") = kPrintCurrentSheet

    ' Check whether the translator has 'SaveCopyAs' options
    If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then

        ' Options for drawings...
          oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentSheet
        oOptions.Value("All_Color_AS_Black") = 0
'          oOptions.Value("Sheet_Range") = kPrintAllSheet
        'oOptions.Value("Remove_Line_Weights") = 0
        'oOptions.Value("Vector_Resolution") = 400
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4

    End If

    ' the destination file name
     'oDataMedium.FileName = ThisDoc.PathAndFileName(False)&".pdf"
     Dim sPath = ThisDoc.Path
     Dim sFolder = "Výkresy PDF"
     Dim sFile = ThisDoc.FileName(False)

     Dim oPDFFolder = System.IO.Path.Combine(sPath, sFolder)

     'Check for the PDF folder and create it if it does not exist
     If Not System.IO.Directory.Exists(oPDFFolder) Then
         System.IO.Directory.CreateDirectory(oPDFFolder)
     End If

     oDataMedium.FileName = System.IO.Path.Combine(sPath, sFolder, sFile & ".pdf")

'     Dim outputFile As String
'     outputFile = ThisDoc.PathAndFileName(False)&"_"&iProperties.Value("Project", "Revision Number")&".pdf"

    'Publish document.
    Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub

Odpovědi:

Odeslal: Vladimír Michl
Datum odeslání: 26.lis.2023 v 12:13

Jméno listu je je ActiveSheet.Name, tedy spíše:

Replace(ActiveSheet.Name,":","_")

-------------
Vladimír Michl (moderátor)
ARKANCE CZ - https://arkance.world - arkance.world
(podpora viz emea.support.arkance.world)

Odeslal: madep
Datum odeslání: 26.lis.2023 v 19:56

Děkuji, funguje to.

Vytisknout stránku | Zavřít okno