It should be. With PROPER programming.
You use "ActiveDocument" calls in your code. Active Document calls only grab the document that is at the forefront of the application, not the document the rule was called from.
You should be using ThisDoc.Document to get the document the rule is called from.
Also, you might not need to activate each sheet, which slows down code, and could probably just access them directly, but that depends on the capabilities of the functions called.
**The 2 rules below, the first is the modified version of OP's "PDF Print", the 2nd one is the verbatim text from OP's attached "Change Titleblock.txt"**
Sub Main()
On Error Resume Next
Dim oDrawingDoc As Inventor.DrawingDocument: oDrawingDoc = ThisDoc.Document
If Err.Number <> 0 Then
MsgBox ("Please open a Drawing to work on.")
Exit Sub
End if
On Error GoTo 0
'reference template
ThisDrawing.ResourceFileName = "C:\Work\InventorResources\Templates\R2017\XXXX.idw" 'XXXX removed name
ThisDrawing.KeepExtraResources = False
Dim SheetNumber As Integer
'Clear out the old Titleblocks & Sheetformats
For SheetNumber = 1 To oDrawingDoc.Sheets.Count
oDrawingDoc.Sheets(SheetNumber).Activate
If Not oDrawingDoc.ActiveSheet.TitleBlock Is Nothing Then
oDrawingDoc.ActiveSheet.TitleBlock.Delete
End If
Next SheetNumber
'Delete the previous title blocks as the API does not support replacing Sheet Formats.'DeleteSheetFormatsAll (oDrawingDoc)'DeleteBorders (oDrawingDoc)
DeleteTitleBlocks (oDrawingDoc)
Dim resu1t As String="Result"
Dim T1TLE As New ArrayList
T1TLE.Add("XXXX") 'XXXX removed name
ActiveSheet.SetTitleBlock("XXXX", "", "", "") 'XXXX removed name
End Sub
Sub DeleteTitleBlocks(oActiveDoc As Inventor.DrawingDocument)
'Iterate through the collection deleting any titleblocks that are not referenced by the drawing object
Dim oTitle As TitleBlockDefinition
For Each oTitle In oActiveDoc.TitleBlockDefinitions
If oTitle.IsReferenced = False Then
oTitle.Delete
End If
Next
End Sub
'define the active document as an assembly file
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)
'check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
Exit Sub
End If
'get user input
RUsure = MessageBox.Show ( _
"This will create a PDF file for all of the asembly components that have drawings files." _
& vbLf & "This rule expects that the drawing file shares the same name and location as the component." _
& vbLf & " " _
& vbLf & "Are you sure you want to create PDF Drawings for all of the assembly components?" _
& vbLf & "This could take a while.", "iLogic - Batch Output PDFs ",MessageBoxButtons.YesNo)
If RUsure = vbNo Then
Return
Else
End If
'- - - - - - - - - - - - -PDF setup - - - - - - - - - - - -
oPath = ThisDoc.Path
PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
If PDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
'oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 1
oOptions.Value("Vector_Resolution") = 400
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
'get PDF target folder path
oFolder = oPath & "\" & oAsmName & " PDF Files"
'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
'- - - - - - - - - - - - -
'- - - - - - - - - - - - -Component Drawings - - - - - - - - - - - -
'look at the files referenced by the assembly
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
'work the the drawing files for the referenced models
'this expects that the model has a drawing of the same path and name
For Each oRefDoc In oRefDocs
idwPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "idw"
'check to see that the model has a drawing of the same path and name
If(System.IO.File.Exists(idwPathName)) Then
Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.Documents.Open(idwPathName, True)
oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName) -3)
iLogicVb.RunExternalRule("CAD NAME")
iLogicVb.RunExternalRule("FINISH")
iLogicVb.RunExternalRule("SCALE X")
iLogicVb.RunExternalRule("CHANGE TITLE BLOCK")
On Error Resume Next ' if PDF exists and is open or read only, resume next
'Set the PDF target file name
oDataMedium.FileName = oFolder & "\" & oFileName & "pdf"
'Write out the PDF
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
'close the file
oDrawDoc.Close
Else
'If the model has no drawing of the same path and name - do nothing
End If
Next
'- - - - - - - - - - - - -
'- - - - - - - - - - - - -Top Level Drawing - - - - - - - - - - - -
oAsmDrawing = ThisDoc.ChangeExtension(".idw")
oAsmDrawingDoc = ThisApplication.Documents.Open(oAsmDrawing, True)
oAsmDrawingName = Left(oAsmDrawingDoc.DisplayName, Len(oAsmDrawingDoc.DisplayName) -3)
'write out the PDF for the Top Level Assembly Drawing file
On Error Resume Next ' if PDF exists and is open or read only, resume next
'Set the PDF target file name
oDataMedium.FileName = oFolder & "\" & oAsmDrawingName & "pdf"
'Write out the PDF
Call PDFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)
'Close the top level drawing
oAsmDrawingDoc.Close
'- - - - - - - - - - - - -
MessageBox.Show("New Files Created in: " & vbLf & oFolder, "iLogic")
'open the folder where the new ffiles are saved
Shell("explorer.exe " & oFolder,vbNormalFocus)
--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.
