Message 1 of 3
PDF code issue looping through sheets
Not applicable
10-31-2018
04:21 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
hi all I have this code and I think I know what is wrong but I can work out how to correct it.
the code makes a pdf of each sheet and names it depending on what is in a prompted entry box.
at the moment it loops through all the sheets and at first glance it looks ok but when you look at each pdf they are all the same (current active sheet). I think the issue is I am looping through all sheets and getting the data but before I pdf it I need to activate that sheet.
any help would be great thanks
Imports SysIO = System.IO
Imports System.Windows.Forms
Sub Main ()
' Get current location of this file
Dim ExportPath As String = ThisDoc.Path
' Check that this file has been saved and actually exists on disk
If String.IsNullOrEmpty(ExportPath) Then
MsgBox("This file has not yet been saved and doesn't exist on disk! - please save it first",64, "Formsprag iLogic")
Return
End If
' Define folder browse dialog
Dim Dialog = New FolderBrowserDialog()
' Set options for folder browser dialog
Dialog.SelectedPath = ExportPath
Dialog.ShowNewFolderButton = True
Dialog.Description = "Choose Folder for Export..."
' Show dialog box
If DialogResult.OK = Dialog.ShowDialog() Then
' User clicked 'ok' on dialog box - capture the export path
ExportPath = Dialog.SelectedPath & "\"
Else
' User clicked 'cancel' on dialog box - exit
Return
End If
'Read Title Block from Active Sheet
oPath = ThisDoc.Path
oFileName = ThisDoc.FileName(False) 'without extension
oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById _
("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oDocument = ThisApplication.ActiveDocument
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
'Define the drawing
Dim oDrawing As DrawingDocument
oDrawing = ThisDoc.Document
Dim oSheet As Sheet
Dim lPos As Long
Dim rPos As Long
Dim sLen As Long
Dim sSheetName As String
Dim iSheetNumber As Integer
'step through each drawing sheet
For Each oSheet In oDrawing.Sheets
'find the seperator in the sheet name:number
lPos = InStr(oSheet.Name, ":")
'find the number of characters in the sheet name
sLen = Len(oSheet.Name)
'find the sheet name
sSheetName = Left(oSheet.Name, lPos -1)
'find the sheet number
sSheetNumber = Right(oSheet.Name, sLen -lPos)
'set PDF Options
If oPDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
oOptions.Value("All_Color_AS_Black") = 1
oOptions.Value("Remove_Line_Weights") = 1
oOptions.Value("Vector_Resolution") = 400
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintSheetRange
oOptions.Value("Custom_Begin_Sheet") = sSheetNumber
oOptions.Value("Custom_End_Sheet") = sSheetNumber
End If
'get PDF target folder path
oFolder = Left(oPath, InStrRev(oPath, "\")) & "PDF"
'Check for the PDF folder and create it if it does not exist
If Not System.IO.Directory.Exists(oFolder) Then
System.IO.Directory.CreateDirectory(oFolder)
End If
Dim oDoc As Document
oDoc = ThisApplication.ActiveDocument
Dim oTB1 As TitleBlock
oTB1 = oSheet.TitleBlock
Dim titleDef As TitleBlockDefinition
titleDef = oTB1.Definition
Dim oPrompt
' Find the Prompted Entry called <MATERIALS> in the Title Block
For Each defText In titleDef.Sketch.TextBoxes
If defText.Text = "drawing number" Then
oPrompt = defText
Exit For
End If
Next
'write prompted entry to iprop
Dim Mat As String
Mat=oTB1.GetResultText(oPrompt)
ExportFilename = Mat & ".pdf"
ExportDWGFileName = Mat & ".dwg"
'____________in loop above
'Set the PDF target file name
oDataMedium.FileName = ExportPath & ExportFilename
'Publish document
oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
'MessageBox.Show(ExportFilename, "Title")
Call DWG (ExportPath,ExportDWGFileName)
Next
MessageBox.Show("Done!", "Done")
End Sub
