oh Sanjay, anything is possible with computers! (well, almost anything)
Here is my printing macro, and no it doesn't print each page to the same pdf, but it will create a series of pdfs that you can then combine.
-------------------------------------------------------------------
Public Sub PrintDrawingToPDF()
' set printer
Dim sPrinter As String
sPrinter = "Adobe PDF"
' get application
Dim oIVApp As Inventor.Application
Set oIVApp = GetInventor
If oIVApp Is Nothing Then Exit Sub
' get document
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = GetActiveDrawing
If oDrawDoc Is Nothing Then Exit Sub
' get print manager
Dim oPM As DrawingPrintManager
Set oPM = oDrawDoc.PrintManager
If Not DrawingCheckPrinter(oPM, sPrinter) Then
MsgBox "Printer " & sPrinter & " was not found", , "Error"
Exit Sub
End If
' loop thru drawing, printing similar sheets together
Dim oSheet As Sheet
Dim oPaperSize As PaperSizeEnum
Dim oOrientation As PrintOrientationEnum
Dim bflag As Boolean
bflag = False
Dim iStart As Integer
Dim iEnd As Integer
Dim i As Integer
i = 1
While oDrawDoc.Sheets.Count >= i
' set size and orientation
Set oSheet = oDrawDoc.Sheets(i)
Let oPaperSize = DrawingGetPaperSizeFromSheet(oSheet)
Let oOrientation = DrawingGetPrintOrientationFromSheet(oSheet)
iStart = i
' find last consecutive sheet with same size and orientation
bflag = False
While oDrawDoc.Sheets.Count >= i And Not bflag
Set oSheet = oDrawDoc.Sheets(i)
If oPaperSize = DrawingGetPaperSizeFromSheet(oSheet) And _
oOrientation = DrawingGetPrintOrientationFromSheet(oSheet) Then
iEnd = i
i = i + 1 ' increment counter
Else
bflag = True
End If
Wend
' print the sheets
With oPM
.Printer = sPrinter
.AllColorsAsBlack = False
.ColorMode = kPrintColorPalette
.NumberOfCopies = 1
.Orientation = oOrientation
.PaperSize = oPaperSize
.TilingEnabled = False
.PrintRange = kPrintSheetRange
.SetSheetRange iStart, iEnd
.SubmitPrint
End With
Wend
End Sub
Public Function GetActiveDrawing() As DrawingDocument
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Set GetActiveDrawing = ThisApplication.ActiveDocument
Else
MsgBox "Must have a drawing active", vbOKOnly, "Error"
End If
End Function
Public Function DrawingGetPaperSizeFromSheet(oSheet As Sheet) As PaperSizeEnum
Dim oPaperSize As PaperSizeEnum
Select Case oSheet.Size
Case kADrawingSheetSize
oPaperSize = kPaperSizeLetter
Case kBDrawingSheetSize
oPaperSize = kPaperSize11x17
Case kCDrawingSheetSize
oPaperSize = kPaperSizeCSheet
Case kDDrawingSheetSize
oPaperSize = kPaperSizeDSheet
Case kEDrawingSheetSize
oPaperSize = kPaperSizeESheet
Case kFDrawingSheetSize
MsgBox "Unknown paper size, print manually", , "Error"
Exit Function
Case kA0DrawingSheetSize
oPaperSize = kPaperSizeA0
Case kA1DrawingSheetSize
oPaperSize = kPaperSizeA1
Case kA2DrawingSheetSize
oPaperSize = kPaperSizeA2
Case kA3DrawingSheetSize
oPaperSize = kPaperSizeA3
Case kA4DrawingSheetSize
oPaperSize = kPaperSizeA4
Case Else
oPaperSize = kPaperSizeDefault
End Select
Let DrawingGetPaperSizeFromSheet = oPaperSize
End Function
Public Function DrawingGetPrintOrientationFromSheet(oSheet As Sheet)
Dim oOrientation As PrintOrientationEnum
Select Case oSheet.Orientation
Case kLandscapePageOrientation
oOrientation = kLandscapeOrientation
Case kPortraitPageOrientation
oOrientation = kPortraitOrientation
Case Else
oOrientation = kDefaultOrientation
End Select
Let DrawingGetPrintOrientationFromSheet = oOrientation
End Function
Public Function DrawingCheckPrinter(oPM As PrintManager, sPrinter As String) As Boolean
On Error Resume Next
oPM.Printer = sPrinter
If Err Then
Err.Clear
DrawingCheckPrinter = False
Else
DrawingCheckPrinter = True
End If
On Error GoTo 0
End Function
Public Function GetInventor(Optional bCreateApp As Boolean = True) As Inventor.Application
On Error Resume Next
Set GetInventor = GetObject(, "Inventor.Application")
If Err Then
Err.Clear
If bCreateApp Then
' ask user to start Inventor
Dim iAns As Integer
iAns = MsgBox("Inventor is not currently running. Would you like to start the program?", vbYesNo)
If iAns = vbYes Then
Set GetInventor = CreateObject("Inventor.Application")
If Not GetInventor Is Nothing Then
GetInventor.visible = True
End If
End If
Else
Set GetInventor = Nothing
End If
End If
On Error GoTo 0
End Function
