Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  PDF aus IDW mit mehreren Blättern

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  PDF aus IDW mit mehreren Blättern (2586 mal gelesen)
Didikalle
Mitglied
Konstrukteur


Sehen Sie sich das Profil von Didikalle an!   Senden Sie eine Private Message an Didikalle  Schreiben Sie einen Gästebucheintrag für Didikalle

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 22. Dez. 2012 13:06    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Inventorgemeinde
Ich habe ein Makro, mit dem ich ein Pdf einer IDW erstelle.

Code:
Public Sub CreatePDF()
On Error Resume Next
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
Exit Sub
End If

Dim oDoc As Inventor.DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
If oDoc.FullFileName = "" Then
MsgBox "Bitte zuerst die Zeichnung speichern..."
Exit Sub
End If
oDoc.SaveAs Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "pdf"), True

If Err.Number = 0 Then
MsgBox "Die Datei:" & vbCrLf & vbCrLf & Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "pdf") & vbCrLf & vbCrLf & "wurde erfolgreich gespeichert"
Else
MsgBox "Fehler: " & Err.Description
End If
End Sub


Was muss ich in diesen Code einfügen, um alle Blätter einer IDW in einer PDF-Datei zu kopieren?
Freue mich schon jetzt auf eure Unterstützung.

------------------
Didi

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2138
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 22. Dez. 2012 19:18    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hi

Nimm das Translator-AddIn.

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

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

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

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

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

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

        ' Options for drawings...

        oOptions.Value("All_Color_AS_Black") = 0

        'oOptions.Value("Remove_Line_Weights") = 0
        'oOptions.Value("Vector_Resolution") = 400
        oOptions.Value("Sheet_Range") = kPrintAllSheets '<------------ alle Blätter ins PDF drucken
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4

    End If

    'Set the destination file name
    oDataMedium.FileName = Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "pdf")

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


------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Didikalle
Mitglied
Konstrukteur


Sehen Sie sich das Profil von Didikalle an!   Senden Sie eine Private Message an Didikalle  Schreiben Sie einen Gästebucheintrag für Didikalle

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 22. Dez. 2012 19:48    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo rkauskh

danke für die schnelle Antwort.
Bei mir klappt der code nicht. Der Debug bleibt an dieser Position hängen:

Code:
    'Set the destination file name
    oDataMedium.FileName = Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "pdf")

------------------
Didi

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2138
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 22. Dez. 2012 20:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hi

Na dann ersetz noch schnell 2x oDoc durch oDocument in der Zeile.

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Didikalle
Mitglied
Konstrukteur


Sehen Sie sich das Profil von Didikalle an!   Senden Sie eine Private Message an Didikalle  Schreiben Sie einen Gästebucheintrag für Didikalle

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 22. Dez. 2012 23:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Ralf

hat funktioniert, hätte ich auch selbst sehen können.
Besten Dank nochmal und frohe Festtage.

------------------
Didi

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Schattenbacke
Mitglied
Dipl.-Ing (FH)


Sehen Sie sich das Profil von Schattenbacke an!   Senden Sie eine Private Message an Schattenbacke  Schreiben Sie einen Gästebucheintrag für Schattenbacke

Beiträge: 114
Registriert: 28.01.2009

Dell Precision T3500
Productstream Professional Easy 2011
Autodesk Inventor 2016

erstellt am: 04. Jan. 2017 09:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Moin,

was muss ich tun um diesen Code so anzupassen, dass er es in dem jeweiligen User Desktop unter dem Ordner "PDF" speichert statt am gleichen Ort, wo die IDW liegt?

Gruß Marcus

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

bkrüger
Mitglied
Konstrukteur


Sehen Sie sich das Profil von bkrüger an!   Senden Sie eine Private Message an bkrüger  Schreiben Sie einen Gästebucheintrag für bkrüger

Beiträge: 51
Registriert: 14.09.2014

Win10 IV2018 Vault2018-WG

erstellt am: 04. Jan. 2017 13:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hallo schattenbacke,

die Zeile

Code:

oDataMedium.FileName = Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "pdf")

wird ersetzt durch folgenden Code:
(wichtig: Verweis auf "Microsoft Scripting Runtime" unter Tools/References setzen)

Code:

Dim oWSH            As Object ' Windows scripting host
Dim sPfad As String
Dim s1 As String
Dim lx1 As Long
'---
Set oWSH = CreateObject("WScript.Shell")
sPfad = oWSH.SpecialFolders("Desktop") & "\pdf\"  ' der Pfad
s1 = ThisApplication.ActiveDocument.FullFileName
lx1 = InStrRev(s1, "\") ' Pos für Beginn Dateiname
s1 = Right(s1, Len(s1) - lx1) ' Name aus Fullfilename extrahieren
s1 = Left(s1, Len(s1) - 3) & "pdf"  ' PDF-Name draus machen, indem die letzten drei Zeichen ersetzt werden
'---
oDataMedium.FileName =  sPfad & s1

Wegen Erhalt der Übersichtlichkeit Code nicht zusammengekürzt.
Ohne Gewähr und ohne Überprüfung, ob Zielverzeichnis existiert.

Gruß Boris

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Schattenbacke
Mitglied
Dipl.-Ing (FH)


Sehen Sie sich das Profil von Schattenbacke an!   Senden Sie eine Private Message an Schattenbacke  Schreiben Sie einen Gästebucheintrag für Schattenbacke

Beiträge: 114
Registriert: 28.01.2009

Dell Precision T3500
Productstream Professional Easy 2011
Autodesk Inventor 2016

erstellt am: 04. Jan. 2017 13:36    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Danke dir, aber das müsste ich dann auf jedem Rechner aktivieren? Das wäre ehrlich gesagt recht ungünstig...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

bkrüger
Mitglied
Konstrukteur


Sehen Sie sich das Profil von bkrüger an!   Senden Sie eine Private Message an bkrüger  Schreiben Sie einen Gästebucheintrag für bkrüger

Beiträge: 51
Registriert: 14.09.2014

Win10 IV2018 Vault2018-WG

erstellt am: 04. Jan. 2017 14:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hallo Schattenbacke,
Versuch macht kluch...
Es könnte sein, dass die Verweise in der ivb abgespeichert werden - diese also beim Laden der ivb gesetzt werden.

Gruß Boris

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Schattenbacke
Mitglied
Dipl.-Ing (FH)


Sehen Sie sich das Profil von Schattenbacke an!   Senden Sie eine Private Message an Schattenbacke  Schreiben Sie einen Gästebucheintrag für Schattenbacke

Beiträge: 114
Registriert: 28.01.2009

Dell Precision T3500
Productstream Professional Easy 2011
Autodesk Inventor 2016

erstellt am: 04. Jan. 2017 14:10    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

bkrüger
Mitglied
Konstrukteur


Sehen Sie sich das Profil von bkrüger an!   Senden Sie eine Private Message an bkrüger  Schreiben Sie einen Gästebucheintrag für bkrüger

Beiträge: 51
Registriert: 14.09.2014

Win10 IV2018 Vault2018-WG

erstellt am: 04. Jan. 2017 15:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hallo Schattenbacke,
bisschen windig - momentan nicht nur draussen - auch dein Script.
Da muss ich mal bisschen meckern :
Weil: Man kann nicht voraussetzen, dass sich der Desktop als Unterverzeichnis im Userverzeichnis (Environ("USERPROFILE")) befindet.
Ich habe u.a. den Desktop auf ein anderes Laufwerk verschoben, weil der Platz der SSD auf C knapp wurde...

Desweiteren fehlt in deinem Script die Überprüfung auf ungespeicherte Datei - ...activedocument.filesavecounter>0 - das ist jedenfalls die saubere Lösung gegenüber dem Test auf ...activedocument.fullfilename<>"".

Warum für den Dateinamen eine extra custom iprop verwenden?
Mmh, der Dateiname steht doch sowieso in ...activedocument.fullfilename (spätestens nach dem ersten Speichern der Datei)
Ausserdem: Existiert dieses Iprop nicht, wird gnadenlos ein Fehler (err.number 91) geworfen...

Ich verwende für pdf/dxf/step/dwf die entsprechenden Translator-Addins (ist in den samples zu finden). Damit bekommt man dann die Optionen gleich mit im Griff...

Was der Automatisierung auch bisschen im Wege steht:
Die stp/pdf-Ausgabe sollte praktischerweise vorher prüfen, ob die zu schreibende Datei bereits vorhanden ist - und diese dann vor der Ausgabe kommentarlos löschen.
Erst dann, wenn das nicht gelingt (weil bspw. die pdf gerade offen ist oder anderweitig Schreibschutz besteht) sollte das Script die Hilfe des Users in Anspruch nehmen.

Und zu guter Letzt:
Da man nie weiß, unter welch widrigen Umständen die Subs aufgerufen werden, sollte man prüfen, ob im Inventor überhaupt eine Datei offen ist.
Das kann man mittels 'on error resume next' und dann die err.number nach der Zuweisung der Objektvariablen odoc machen oder aber man benutzt ThisApplication.Documents.VisibleDocuments.Count  - der sollte >0 sein.

Wie gesagt, nur bisschen Gemecker, gerade das Abfangen von Fehlern sollte man sich zu Herzen nehmen - denn garantiert wird der unbedarfte User es schon beim Erstkontakt mit dem Script schaffen, bis dato noch nie gesehene Fehlermeldungen zu produzieren. Noch besser ist es nur noch, wenn einem das bei der Vorführung des eigenen Scripts passiert...

Gruß Boris

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Krissi70
Mitglied



Sehen Sie sich das Profil von Krissi70 an!   Senden Sie eine Private Message an Krissi70  Schreiben Sie einen Gästebucheintrag für Krissi70

Beiträge: 28
Registriert: 16.05.2013

erstellt am: 01. Feb. 2017 10:48    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Was ist mit iLogic (externe Regel)?

Code:

'
'PDF erstellen - alle Seiten einzeln
'

Dim oSheetName As String
Dim erste_Seite As String
Dim oDoc As DrawingDocument
Dim oSheets As Sheet
oDoc = ThisApplication.ActiveDocument
erste_Seite = ""

For Each oSheets In oDoc.Sheets

oSheets.Activate
oSheet = ActiveSheet
oFileName = ThisDoc.FileName(False) 'without extension
oRevNum = iProperties.Value("Project", "Revision Number")
oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById _
("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oDocument = ThisApplication.ActiveDocument
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

oSheetName =  Right(oSheet.Name,1) 'Blattnummer

If oSheetName = "1" Then
erste_Seite = oSheet.Name
End If

If oPDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 1
oOptions.Value("Vector_Resolution") = 400
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentsheet

End If

Dim WshShell As Object
WshShell = CreateObject("WScript.Shell")
oFolder = WshShell.SpecialFolders("Desktop") & "\pdf"
WshShell = Nothing

'Prüfen ob PDF Verzeichnis auf dem Desktop vorhanden ist,
'wenn nicht wird es erstellt
If Not System.IO.Directory.Exists(oFolder) Then
    System.IO.Directory.CreateDirectory(oFolder)
End If

oDataMedium.FileName = oFolder & "\" & oFileName & "_Blatt-" & oSheetName & ".pdf"
oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)

Next

ActiveSheet = ThisDrawing.Sheet(erste_Seite)



Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Mr. Crazyy
Mitglied


Sehen Sie sich das Profil von Mr. Crazyy an!   Senden Sie eine Private Message an Mr. Crazyy  Schreiben Sie einen Gästebucheintrag für Mr. Crazyy

Beiträge: 4
Registriert: 16.09.2022

erstellt am: 16. Sep. 2022 08:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hallo,

ich habe mal eine Frage zu dem Exportieren von PDFs mittels VBA.
Ich wollte keinen neuen Beitrag erstellen und verwende diesen. Ich hoffe das ist OK.
Leider kenne ich mich mit VBA nicht aus und habe das Makro mir per Copy&Paste gebastelt.
Soweit funktioniert es sehr zuverlässig.

Ich möchte das in dem Dateinamen die Revision erscheint.
Also so
<Zeichnungsnummer><Revision>_<Datum>.pdf

Das Problem ist das bei uns die Revison nur in den Modellen eingetragen werden.
In dem Zeichnungskopf wird dann die Revision aus dem Modell angezogen.

Geht das auch für ein Makro/VBA?

Mit:
Dim oDocRevision As Property
Set oDocRevision = oDocument.PropertySets.Item("Inventor Summary Information").Item("Revision Number")
komme ich nur an die Revision der IDW.

Hier mein aktuelles Makro:

Public Sub PDF_Export()
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    Set oDocument = ThisApplication.ActiveDocument

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

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

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

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

        ' Options for drawings...

        oOptions.Value("All_Color_AS_Black") = 0
        oOptions.Value("Remove_Line_Weights") = 0
        oOptions.Value("Vector_Resolution") = 1200
        oOptions.Value("Sheet_Range") = kPrintAllSheets '<------------ alle Blätter ins PDF drucken
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4

    End If
   
    'Speicherort
    oDataMedium.FileName = "I:\Export\"
   
    'Zeichnungsnummer
    oDataMedium.FileName = oDataMedium.FileName & Left(oDocument.DisplayName, Len(oDocument.DisplayName) - 4)
   
    'Datum
    oDataMedium.FileName = oDataMedium.FileName & "_" & Year(Now) & "-" & Right("0" & Month(Now), 2) & "-" & Right("0" & Day(Now), 2)
   
    'Dateiendung
    oDataMedium.FileName = oDataMedium.FileName & ".pdf"
   
    'Publish document.
    Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub


Hat jemand eine Idee?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2138
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 16. Sep. 2022 08:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hallo

Willkommen im Forum. 

Ein neuer Beitrag wäre besser gewesen, da deine Frage nicht wirklich mit der ursprünglichen zu tun hat. Egal, für deine Revisionsinfo musst du dir das referenzierte Dokument der IDW holen. Wenn die Empfehlung nicht mehrere 3D-Modelle in eine Zeichnung zu packen eingehalten wurde und das es mindestens eine Erstansicht gibt, dann so:

Code:

Dim oRefedDocument as Document
Set oRefedDocument = oDocument.ReferencedDocuments(1)

Dim oDocRevision As Property
Set oDocRevision = oRefedDocument.PropertySets.Item("Inventor Summary Information").Item("Revision Number")


------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

KraBBy
Mitglied
Maschinenbau-Ingenieur


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 584
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 16. Sep. 2022 09:12    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Code:
Sub test()
   
    'aktives document -> idw
    Dim oDocument As Document   'hier evtl. DrawingDocument verwenden, oder prüfen, ob das aktive Doc. auch Zg. ist
    Set oDocument = ThisApplication.ActiveDocument
   
    'Revision des aktiven Documents
    Dim oDocRevision As Property
    Set oDocRevision = oDocument.PropertySets.Item("Inventor Summary Information").Item("Revision Number")

    'Referenziertes Dokument -> Modell (iam oder ipt)
    Dim oRefDoc As Document
    Set oRefDoc = oDocument.ReferencedDocuments.Item(1)
    ' evtl. vorher noch prüfen, ob ReferencedDocuments.Count = 1
    ' sonst Fehler, wenn kein Modell referenziert wird
    ' evtl. auch problematisch, wenn mehrere Modelle, dann wird Rev. vom "ersten" genommen
   
    'Revision des refDoc
    Dim oRefDocRev As Property
    Set oRefDocRev = oRefDoc.PropertySets.Item("Inventor Summary Information").Item("Revision Number")

    'Ergebnis zum Vergleich
    MsgBox "oDoc: " & vbTab & oDocRevision.Value & vbCrLf _
        & "oRefDoc:" & vbTab & oRefDocRev.Value, vbOKOnly, "Revision"
   
End Sub


Edit: Ralf war schneller

------------------
Gruß KraBBy

[Diese Nachricht wurde von KraBBy am 16. Sep. 2022 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Mr. Crazyy
Mitglied


Sehen Sie sich das Profil von Mr. Crazyy an!   Senden Sie eine Private Message an Mr. Crazyy  Schreiben Sie einen Gästebucheintrag für Mr. Crazyy

Beiträge: 4
Registriert: 16.09.2022

erstellt am: 16. Sep. 2022 09:36    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Oh super!!!

Vielen dank es funktioniert.

Da wir die iPropertys aus dem ersten eingefügten Modell für den Schriftkopf benötigen rechne ich nicht mit problemen.

1000 Dank für die schnellen antworten.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Mr. Crazyy
Mitglied


Sehen Sie sich das Profil von Mr. Crazyy an!   Senden Sie eine Private Message an Mr. Crazyy  Schreiben Sie einen Gästebucheintrag für Mr. Crazyy

Beiträge: 4
Registriert: 16.09.2022

erstellt am: 22. Sep. 2022 13:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hallo nochmal,

ich habe jetzt folgendes Problem:

Das Skript nimmt nicht die Zeichnungsnummer aus dem zuerst eingefügten Modell sondern aus dem zuletzt eingefügten.
Wenn wir jetzt eine Zeichnung haben wo wir noch ein weiteres Modell einfügen wird immer dessen Zeichnungsnummer angezogen.

hier mein Skript:

Public Sub PDF_Export()
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
   
    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    Set oDocument = ThisApplication.ActiveDocument

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

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

    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
   
    ' Referenziertes Dokument einbinden
    Dim oRefedDocument As Document
    Set oRefedDocument = oDocument.ReferencedDocuments(1)
   
    ' Zeichnungsnummer aus .iam/.idw
    Dim oDocPartNumber As Property
    Set oDocPartNumber = oRefedDocument.PropertySets.Item("Design Tracking Properties").Item("Part Number")
       
    ' Revisionsnummer aus .iam/.idw
    Dim oDocRevision As Property
    Set oDocRevision = oRefedDocument.PropertySets.Item("Inventor Summary Information").Item("Revision Number")
   
    ' Check whether the translator has 'SaveCopyAs' options
    If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then

        ' Options for drawings...

        oOptions.Value("All_Color_AS_Black") = 0
        oOptions.Value("Remove_Line_Weights") = 0
        oOptions.Value("Vector_Resolution") = 1200
        oOptions.Value("Sheet_Range") = kPrintAllSheets '<------------ alle Blätter ins PDF drucken
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4

    End If

    'Set the destination file name
    'oDataMedium.FileName = Replace(oDocument.FullFileName, Right(oDocument.FullFileName, 3), "pdf")
    'oDataMedium.FileName = "I:\Export\" & Left(oDocument.DisplayName, Len(oDocument.DisplayName) - 3) & "pdf"
    'oDataMedium.FileName = "I:\Export\" & Left(oDocument.DisplayName, Len(oDocument.DisplayName) - 4) & "_" & Year(Date) & "-" & Month(Date) & "-" & Day(Date) & ".pdf"
   
    'Speicherort
    oDataMedium.FileName = "I:\Export\"
   
    'Zeichnungsnummer
    'oDataMedium.FileName = oDataMedium.FileName & Left(oDocument.DisplayName, Len(oDocument.DisplayName) - 4)
    oDataMedium.FileName = oDataMedium.FileName & oDocPartNumber.Value
       
    'Revisionsnummer
    oDataMedium.FileName = oDataMedium.FileName & oDocRevision.Value
   
    'Datum
    oDataMedium.FileName = oDataMedium.FileName & "_" & Year(Now) & "-" & Right("0" & Month(Now), 2) & "-" & Right("0" & Day(Now), 2)
   
    'Dateiendung
    oDataMedium.FileName = oDataMedium.FileName & ".pdf"
   
    'Publish document.
    Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2138
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 22. Sep. 2022 15:52    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Hallo

Wenn die Empfehlung nicht mehrere 3D-Modelle in eine Zeichnung zu packen eingehalten wurde und das es mindestens eine Erstansicht gibt, dann so:

Habe ich doch extra drauf hingewiesen. Dann nimm die erste Ansicht auf dem ersten Zeichnungsblatt. Bringt natürlich auch nichts, wenn man nachträglich ein neues erstes Blatt einfügt.

Code:

Dim oRefedDocument as Document
Set oRefedDocument = oDocument.Sheets(1).DrawingViews(1).ReferencedDocumentDescriptor.ReferencedDocument


------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Mr. Crazyy
Mitglied


Sehen Sie sich das Profil von Mr. Crazyy an!   Senden Sie eine Private Message an Mr. Crazyy  Schreiben Sie einen Gästebucheintrag für Mr. Crazyy

Beiträge: 4
Registriert: 16.09.2022

erstellt am: 23. Sep. 2022 09:02    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Didikalle 10 Unities + Antwort hilfreich

Super DANKE!!

Da hatte ich mich etwas ungeschickt ausgedrückt.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz