Doug,
Below you will find my current macro I use that outputs both pdf and
tiff files. The tiff is made by converting the pdf file using
ghostscript, so you will have to install that if you don't have it
already. I just recently converted this from using Win2pdf to
make the pdf file, as it seems Autodesk has finally fixed their
output to a level that I can accept. There may be some variables
that aren't used anymore, and I might do more with building the
filenames than you need. Should be able to figure it all out though.
Currently, it does not work well if you have spaces in the path
or filename (for the ghostscript command), and since changing to the
save copy as pdf option, I seem to get some random crashes during
the pdf creation phase, after the macro has run a few times per
session. Not sure who's fault that is? I'm currently using IV2009
32 bit on XP. This macro only saves the currently active sheet to
pdf. You can probably change that if you want. Not sure if ghostscript
handles creating multipage tiff files from pdf or not? No error checking
in this puppy either. Enjoy!
Bob S.
Doug6598 wrote:
> Bob,
> We are looking to export IDW to TIF. Was wondering if you may be able to share more info about your macro or possibly some example code or TIF files that were created with it ?
>
> Thanks,
> Doug
>
>> {quote:title=Guest wrote:}{quote}
>> I had tried using the PrintToFile method before when I was writing
>> my plot2pdf macro sometime ago. I remember that it did not work
>> (couldn't open the files). Found another pdf printer that I could
>> pass it the filename to print to without using the printtofile
>> method. It's called win2pdf. My macro also then runs a ghostscript
>> command to also create a monochrome tiff file from the pdf.
>>
>> Bob S.
Public Sub SaveDrawing_PDF()
Dim FullFilename As String
Dim PDFFilename As String
Dim TIFFilename As String
Dim Path As String
Dim myDate As String
myDate = Format(Month(Date), "0#") & Format(Day(Date), "0#") & Right(Year(Date), 2)
Dim mySheet As Sheet
Dim mySheetHgt As Double
Dim mySheetWid As Double
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
' Get a reference to the "Design State" property.
Dim oPropSets As PropertySets
Set oPropSets = oDrawDoc.PropertySets
Dim oProp As Property
Set oProp =
oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kDesignStatusDesignTrackingProperties)
Dim DesignState As String
Select Case oProp.Value
Case 0 To 2
DesignState = "_PENDING_"
Case 3
DesignState = "_FINAL_"
End Select
Dim sNum As Integer
Dim sCount As Integer
Set mySheet = oDrawDoc.ActiveSheet
mySheetHgt = mySheet.height
mySheetWid = mySheet.Width
'MsgBox "Sheet Size: " & mySheetHgt & " x " & mySheetWid
'Set mySheet = oDrawDoc.Sheets.Item(1) '1 would become the sheet num passed
sCount = oDrawDoc.Sheets.Count
sNum = SheetPosition(mySheet)
'just add the sheet number to all.
PDFFilename = Left(oDrawDoc.FullFilename, Len(oDrawDoc.FullFilename) - 4) & "_SHT_" & sNum & "_OF_" & sCount &
DesignState & myDate & ".pdf"
TIFFilename = Left(oDrawDoc.FullFilename, Len(oDrawDoc.FullFilename) - 4) & "_SHT_" & sNum & "_OF_" & sCount &
DesignState & myDate & ".tif"
'Code here to use Save Copy As PDF
' 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
' Check whether the translator has 'SaveCopyAs' options
If PDFAddIn.HasSaveCopyAsOptions(oDrawDoc, oContext, oOptions) Then
' Options for drawings...
oOptions.Value("All_Color_AS_Black") = 0
'oOptions.Value("Remove_Line_Weights") = 1
'oOptions.Value("Vector_Resolution") = 1
'oOptions.Value("Sheet_Range") = kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
'Set the destination file name
oDataMedium.FileName = PDFFilename
'Publish document.
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
'Shell command to convert pdf to tif:
Dim RetVal
Dim Cmdline As String
Cmdline = "C:\gs\gs8.13\bin\gswin32c -q -dNOPAUSE -sDEVICE=tiffg4 -r200 -sOutputFile="
Cmdline = Cmdline & TIFFilename & " " & PDFFilename & " -c quit"
Debug.Print Cmdline
RetVal = Shell(Cmdline, vbNormalFocus)
End Sub
