Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Anonymous
in reply to: MechMachineMan

Hello - I have the same issue. Would greatly appreciate any help. Thank you!

 

 

 



'this rule outputs all drawing sheets to PDF 'this rule outputs all drawing sheets to DWF, 3D models of first sheet included Public Sub Main() 'Ask to print file printerName = "\\JLF-PRINT01\Canon Meadow Lighting_Dept PS3" askprint = MessageBox.Show("Print to " & printerName & "?", "Print",MessageBoxButtons.YesNoCancel) If askprint = vbYes Dim oDrawDoc As Document oDrawDoc = ThisApplication.ActiveDocument Dim oPrintMgr As PrintManager oPrintMgr = oDrawDoc.PrintManager 'specify your printer name '\\JLF-PRINT01\Canon Meadow Lighting_Dept PS3 oPrintMgr.Printer = printerName oPrintMgr.PrintRange = Inventor.PrintRangeEnum.kPrintAllSheets oPrintMgr.ColorMode = PrintColorModeEnum.kPrintGrayScale oPrintMgr.AllColorsAsBlack = False oPrintMgr.Orientation = PrintOrientationEnum.kPortraitOrientation oPrintMgr.PaperSize = SizeActiveSheet oPrintMgr.SubmitPrint Else If askprint = vbCancel Goto ErrorHandle End If 'Set-Up declarations for DPF and DWF add-ins PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}") DWFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}") oDocument = ThisApplication.ActiveDocument oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism PDFOptions = ThisApplication.TransientObjects.CreateNameValueMap DWFOptions = ThisApplication.TransientObjects.CreateNameValueMap PDFOptions = ThisApplication.TransientObjects.CreateDataMedium DWFOptions = ThisApplication.TransientObjects.CreateDataMedium 'Define the save path Dim fileName As String filename = ThisDoc.FileName(True) Prefix = Left(fileName, 3) 'First 3 characters i.e. "803" FirstSpace = InStr(1, fileName, " ") 'Gets location in strine of the first space If Not FirstSpace = 0 PartNumber = Left(fileName, FirstSpace-1) 'Assign everything left of the space to part number Else 'There is no space dot = InStr(1, fileName, ".") 'Gets the location in string of the first "." PartNumber = Left(fileName, dot-1) 'Assign everything left of the "." to part number End If 'PartNumber = Left(fileName, 9) 'Full Part number i.e. "803-00044" 'last5 = Right(DNumber, 5) 'Last 5 characters i.e. "00044" 'Image Library folder names have additional descriptors... If Left(Prefix, 3) = "801" folderDescription = "Table Lamps" Else If Left(Prefix, 3) = "802" folderDescription = "Floor Lamps" Else If Left(Prefix, 3) = "803" folderDescription = "Wall Lamps" Else If Left(Prefix, 3) = "804" folderDescription = "Ceiling Lamps" Else If Left(Prefix, 3) = "809" folderDescription = "Shades" End If PDF_Path = "I:\" & Prefix & " - " & folderDescription & "\PDF" DWF_Path = "I:\" & Prefix & " - " & folderDescription & "\DWF" 'Create PDF file PDF_File_Name = PartNumber & "-" & iProperties.Value("Project", "Project") & ".pdf" 'Debug line to show PDF save path 'MessageBox.Show(PDF_PATH, "PDF Save Path") If PDFAddIn.HasSaveCopyAsOptions(PDFDataMedium, oContext, PDFOptions) Then PDFOptions.Value("All_Color_AS_Black") = 0 PDFOptions.Value("Remove_Line_Weights") = 0 PDFOptions.Value("Vector_Resolution") = 4800 PDFOptions.Value("Gradient_Resolution") = 4800 PDFOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets 'PDFOptions.Value("Custom_Begin_Sheet") = 2 'PDFOptions.Value("Custom_End_Sheet") = 4 End If 'Set the PDF target file name 'Shop Drawing If ActiveSheet.TitleBlock = "MEADOW SHOP TITLE BLOCK" Cloc = InStr(1, fileName, "C") 'Gets location in string of the "C" If Cloc = 0 MFG_Folder = PartNumber & "-C" 'Add "-C" to PartNumber PDF_File_Name = ThisDoc.FileName(False) & ".pdf" Else MFG_Folder = Left(PartNumber, Cloc) 'Crop the end of Shop Drawing Part Number to the "C" PDF_File_Name = PartNumber & ".pdf" End If Shop_PDF_Path = PDF_Path & "\MFG DRAWINGS\" & MFG_Folder PDFDataMedium.FileName = Shop_PDF_Path & "\" & PDF_File_Name 'MessageBox.Show(Shop_PDF_PATH, "PDF Save Path") Else 'MessageBox.Show(PDF_PATH, "PDF Save Path") PDFDataMedium.FileName = PDF_Path & "\" & PDF_File_Name End If 'Publish PDF document Try PDFAddIn.SaveCopyAs(oDocument, oContext, PDFOptions, PDFDataMedium) Catch MessageBox.Show("Error - PDF may be open in another viewer, or destination folder does not exist.", "Problem saving PDF to P", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try If ActiveSheet.TitleBlock = "MEADOW SALES TITLE BLOCK" 'Sales Drawing 'Publish copy with Rev info in Project Directory copy_Path = ThisDoc.Path & "/" & PartNumber & " DOCS" copy_FileName = PartNumber & "-" & iProperties.Value("Project", "Project") & " Rev " & iProperties.Value("Project", "Revision Number") & ".pdf" PDFDataMedium.FileName = copy_Path & "\" & copy_FileName PDFAddIn.SaveCopyAs(oDocument, oContext, PDFOptions, PDFDataMedium) 'Create DWF file 'Store and delete Project, Side Mark, & Quantity storeProject = iProperties.Value("Project", "Project") storeSideMark = iProperties.Value("Custom", "SIDEMARK") storeQuantity = iProperties.Value("Custom", "QUANTITY") iProperties.Value("Project", "Project") = "" iProperties.Value("Custom", "SIDEMARK") = "" iProperties.Value("Custom", "QUANTITY") = "" InventorVb.DocumentUpdate() DWF_File_Name = PartNumber & ".dwf" 'Debug line to show DWF save path 'MessageBox.Show(DWF_PATH, "DWF Save Path" 'askview = MessageBox.Show("Launch the DWF Viewer now?", "Launch DWF Viewer",MessageBoxButtons.YesNo) 'If askview = vbYes Then : launchviewer = 1 : Else : launchviewer = 0 : End IF launchviewer = 0 If DWFAddIn.HasSaveACopyAsOptions(DWFDataMedium, oContext, DWFOptions)Then DWFOptions.Value("Launch_Viewer") = launchviewer DWFOptions.Value("Publish_All_Component_Props") = 1 DWFOptions.Value("Publish_All_Physical_Props") = 1 DWFOptions.Value("Password") = 0 DWFOptions.Value("Publish_3D_Models") = Publish_3D_Models If TypeOf oDocument Is DrawingDocument Then Dim oSheets As NameValueMap oSheets = ThisApplication.TransientObjects.CreateNameValueMap DWFOptions.Value("Publish_Mode") = DWFPublishModeEnum.kCompleteDWFPublish DWFOptions.Value("Publish_All_Sheets") = 1 'Publish the first sheet AND its 3D model Dim oSheet1Options As NameValueMap oSheet1Options = ThisApplication.TransientObjects.CreateNameValueMap oSheet1Options.Add("Name", "Sheet:1") oSheet1Options.Add("3DModel", True) oSheets.Value("Sheet1") = oSheetOptions End If End If DWFDataMedium.FileName = DWF_PATH & "\" & DWF_File_Name Try Call DWFAddin.SaveCopyAs(oDocument, oContext, DWFOptions, DWFDataMedium) Catch MessageBox.Show("Error - DWF may be open in another viewer, or destination folder does not exist.", "Problem saving to DWF to P", MessageBoxButtons.OK, MessageBoxIcon.Error) 'Restore Project, Side Mark, Quantity fields iProperties.Value("Project", "Project") = storeProject iProperties.Value("Custom", "SIDE MARK") = storeSideMark iProperties.Value("Custom", "QUANTITY") = storeQuantity InventorVb.DocumentUpdate() End Try If launchviewer = 1 Then ThisDoc.Launch(DWF_PATH & "\" & DWF_File_Name) 'Export copy to project directory copy_Path = ThisDoc.Path & "\" & PartNumber & " DOCS" copy_FileName = PartNumber & " REV " & iProperties.Value("Project", "Revision Number") & ".dwf" DWFOptions.Value("Launch_Viewer") = 0 'Dont launch viewer for the copy DWFDataMedium.FileName = copy_Path & "\" & copy_FileName Call DWFAddIn.SaveCopyAs(oDocument, oContext, DWFOptions, DWFDataMedium) 'Restore Project, Side Mark, Quantity Fields iProperties.Value("Project", "Project") = storeProject iProperties.Value("Custom", "SIDE MARK") = storeSideMark iProperties.Value("Custom", "QUANTITY") = storeQuantity InventorVb.DocumentUpdate() ErrorHandle: If OldDrawing = 1 MessageBox.Show("Unable to remove Project information - old Title Block format", "Error", MessageBoxButtons.OK, MessageBoxIcon.Warning) End If End If End Sub