Code:
Public Sub PDF()
Dim oDoc As DrawingDocument
Dim Msg
' If an error occurs, construct an error message
On Error Resume Next ' Defer error handling.
Err.Clear
'Err.Raise 6 ' Generate an "Overflow" error.
' Check for error, then show message.
If Err.Number <> 0 Then
Msg = "KeineZeichnung "
MsgBox Msg
End If
Set oDoc = ThisApplication.ActiveDocument
' 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("Publish_All_Sheets") = 1
'oOptions.Value("Remove_Line_Weights") = 0
'oOptions.Value("Vector_Resolution") = 400
'oOptions.Value("Sheet_Range") = kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
.....
iRev = aktuelle Revisionsnummer
.....
Set oDoc = ThisApplication.ActiveDocument
'Get the PropertySets
Dim oPropertySets As PropertySets
Set oPropertySets = oDoc.PropertySets
Dim oPropertySet As PropertySet
Set oPropertySet = oDoc.PropertySets.Item("Inventor Summary Information") ' ("Inventor User Defined Properties")
'Get the Property
Dim oProperty As Property
'Revisionsnummer von der Zeichnung
Set oProperty = oPropertySet.Item("Revision Number")
oProperty.Value = iRev
'Revisionsnummer von dem Erstansicht
Dim oReferencedPartDoc As Document
Set oReferencedPartDoc = oDoc.ReferencedDocuments.Item(1)
oReferencedPartDoc.PropertySets.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").Item("Revision Number").Value = iRev
oDoc.Update
'---------------------------------------
''Farbe ändern
'Dim colordoc As DrawingDocument
'Set colordoc = ThisApplication.ActiveDocument
'colordoc.SheetSettings.SheetColor = ThisApplication.TransientObjects.CreateColor(255, 255, 255)
Dim pdfpath As String
pdfpath = Replace(oDoc.FullDocumentName, ".idw", "") & " Rev " & iRev & ".pdf"
oDataMedium.FileName = pdfpath
' Create a new FileDialog object.
Dim oFileDlg As FileDialog
Call ThisApplication.CreateFileDialog(oFileDlg)
' Define the filter to select part and assembly files or any file.
oFileDlg.Filter = "Inventor Files (*.pdf)|*.pdf|All Files (*.*)|*.*"
' Define the part and assembly files filter to be the default filter.
oFileDlg.FilterIndex = 1
' Set the title for the dialog.
oFileDlg.DialogTitle = "Save File" & pdfpath
' Set the initial directory that will be displayed in the dialog.
oFileDlg.InitialDirectory = "I:\orga\Betrieb"
oFileDlg.FileName = pdfpath
' Set the flag so an error will be raised if the user clicks the Cancel button.
oFileDlg.CancelError = True
' Show the Save dialog
On Error Resume Next
oFileDlg.ShowSave
' If an error was raised, the user clicked cancel, otherwise display the filename.
If Err Then
Resume Next
Else
' Publish document.
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
Call oDoc.SaveCopyAs("C:\Temp\TestFile.pdf", True)
End If
End Sub
Foren auf CAD.de (alle Foren)
| 
