Code:
Private Sub btn_dxf_pdf_Click()'PDF-Erstellung
'Set a reference to the active document (the document to be published).
Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument
Dim bErr As Boolean
Dim fso As Object
Dim dDoc As Document
Set fso = CreateObject("Scripting.FilesystemObject")
Dim ret As Variant
Set dDoc = ThisApplication.ActiveDocument
If dDoc.FullFileName = "" Then
MsgBox "Bitte zuerst die Datei speichern... "
Exit Sub
End If
' Get the PDF translator Add-In.
Dim PDFAddIn As TranslatorAddIn
Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
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
Dim oZeichNr As Inventor.Property
On Error GoTo ErrorHandler
Set oZeichNr = dDoc.PropertySets(4).Item("Zeichnungsnummer")
Dim oBlattNr As Inventor.Property
On Error GoTo ErrorHandler
Set oBlattNr = dDoc.PropertySets(4).Item("Blatt")
Dim oRevNr As Inventor.Property
On Error GoTo ErrorHandler
Set oRevNr = dDoc.PropertySets(4).Item("Index")
' Check whether the translator has 'SaveCopyAs' options
If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
'oOptions.Value("All_Color_AS_Black") = 0
'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
'Set the destination file name
If bErr = False Then
oDataMedium.filename = "C:\GAIN\Exchange\" & "\" & oZeichNr.Value & "-" & oBlattNr.Value & "_" & oRevNr.Value & ".pdf"
Else
oDataMedium.filename = "C:\GAIN\Exchange\" & NameSplit(oDocument.FullFileName) & ".pdf"
End If
End If 'Publish document.
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
MsgBox "PDF wurde unter -- C:\GAIN\Exchange -- gespeichert!!"
Exit Sub
ErrorHandler:
bErr = True
Resume Next
'DXF-Erstellung
' Get the DXF translator Add-In.
Dim DXFAddIn As TranslatorAddIn
Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
'Set a reference to the active document (the document to be published).
Set oDocument = ThisApplication.ActiveDocument
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
' Create a NameValueMap object
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
' Check whether the translator has 'SaveCopyAs' options
If DXFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
Dim strIniFile As String
strIniFile = "C:\tempDXFOut.ini"
' Create the name-value that specifies the ini file to use.
oOptions.Value("Export_Acad_IniFile") = strIniFile
End If
'Set the destination file name
oDataMedium.filename = "c:\tempdxfout.dxf"
'Publish document.
Call DXFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub
Private Function NameSplit(ByVal sFilename As String) As String
Dim oArray() As String
oArray = Split(sFilename, "\")
NameSplit = Replace(oArray(UBound(oArray)), ".idw", "")
End Function
Foren auf CAD.de (alle Foren)
| 
