Sub Main If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then MsgBox("An Assembly must be active for this rule to work. Exiting rule.", vbCritical, "WRONG DOCUMENT TYPE") Exit Sub End If Dim oADoc As AssemblyDocument = ThisDoc.Document Dim bAsmStep As Boolean = ExportToSTEP(oADoc) 'runs the custom Sub routine defined below Dim sAsmDrawingFile As String = System.IO.Path.ChangeExtension(oADoc.FullFileName, ".idw") If System.IO.File.Exists(sAsmDrawingFile) Then Dim oAsmDrawing As DrawingDocument = ThisApplication.Documents.Open(sAsmDrawingFile, False) Dim bAsmPDF As Boolean = ExportIDWToPDF(oAsmDrawing) 'runs the custom Sub routine defined below oAsmDrawing.ReleaseReference End If Dim oRefDocs As DocumentsEnumerator = oADoc.AllReferencedDocuments If oRefDocs.Count = 0 Then Exit Sub For Each oRefDoc As Document In oRefDocs If ThisApplication.FileManager.IsInventorComponent(oRefDoc.FullFileName) = False Then Continue For Dim bRefDocStep As Boolean = ExportToSTEP(oRefDoc) 'runs the custom Sub routine defined below Dim sRefDocDrawingFile As String = System.IO.Path.ChangeExtension(oRefDoc.FullFileName, ".idw") If System.IO.File.Exists(sRefDocDrawingFile) Then Dim oRefDocDrawing As DrawingDocument = ThisApplication.Documents.Open(sRefDocDrawingFile, False) Dim bRefDocPDF As Boolean = ExportIDWToPDF(oRefDocDrawing) 'runs the custom Sub routine defined below oRefDocDrawing.ReleaseReference End If Next 'oRefDoc ThisApplication.Documents.CloseAll(True) 'closes all unreferenced documents only End Sub Function ExportIDWToPDF(oDDoc As DrawingDocument) As Boolean If oDDoc Is Nothing Then Return False Dim sPDFfile As String = System.IO.Path.ChangeExtension(oDDoc.FullFileName, ".pdf") Dim oPDFAddin As TranslatorAddIn = Nothing Try : oPDFAddin = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}") : Catch : End Try If IsNothing(oPDFAddin) Then Logger.Debug("Could not get TranslatorAddIn for PDF's by its ID.") Return False End If Dim oTO As TransientObjects = ThisApplication.TransientObjects Dim oContext As TranslationContext = oTO.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism Dim oOptions As NameValueMap = oTO.CreateNameValueMap Dim oDataMedium As DataMedium = oTO.CreateDataMedium If System.IO.File.Exists(sPDFfile) = True Then Dim oAns As MsgBoxResult = MsgBox("The following PDF file already exists:" & vbCrLf & _ sPDFfile & vbCrLf & _ "Do you want to overwrite it?", vbYesNo + vbQuestion + vbDefaultButton2, "PDF ALREADY EXISTS") If oAns = vbNo Then Return True End If oDataMedium.FileName = sPDFfile If oPDFAddin.HasSaveCopyAsOptions(oDDoc, oContext, oOptions) Then oOptions.Value("Publish_All_Sheets") = 1 ' 0 = False, 1 = True oOptions.Value("Launch_Viewer") = 0 ' 0 = False, 1 = True oOptions.Value("All_Color_AS_Black") = 0 ' 0 = False, 1 = True oOptions.Value("Vector_Resolution") = 600 oOptions.Value("Remove_Line_Weights") = 1 ' 0 = False, 1 = True Try oPDFAddin.SaveCopyAs(oDDoc, oContext, oOptions, oDataMedium) Return True Catch oEx As Exception Logger.Error("Error Exporting The Following Drawing File To PDF:" & vbCrLf & oDDoc.FullFileName) Return False End Try Else Return False End If End Function Function ExportToSTEP(oDoc As Document) If oDoc Is Nothing Then Return False Dim sSTEPfile As String = System.IO.Path.ChangeExtension(oDoc.FullFileName, ".stp") Dim oSTEP As TranslatorAddIn = Nothing Try : oSTEP = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}") : Catch : End Try If oSTEP Is Nothing Then Logger.Debug("Could not get TranslatorAddIn for STEP files by its ID.") Return False End If Dim oTO As TransientObjects = ThisApplication.TransientObjects Dim oContext As TranslationContext = oTO.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism Dim oOptions As NameValueMap = oTO.CreateNameValueMap Dim oDataMedium As DataMedium = oTO.CreateDataMedium If System.IO.File.Exists(sSTEPfile) = True Then Dim oAns As MsgBoxResult = MsgBox("The following STEP file already exists:" & vbCrLf & _ sSTEPfile & vbCrLf & _ "Do you want to overwrite it?", vbYesNo + vbQuestion + vbDefaultButton2, "STEP FILE ALREADY EXISTS") If oAns = vbNo Then Return True End If oDataMedium.FileName = sSTEPfile If oSTEP.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then ' Set application protocol. ' 2 = AP 203 - Configuration Controlled Design ' 3 = AP 214 - Automotive Design oOptions.Value("ApplicationProtocolType") = 3 oOptions.Value("IncludeSketches") = True oOptions.Value("export_fit_tolerance") = .000393701 'minimum oOptions.Value("Author") = ThisApplication.GeneralOptions.UserName oOptions.Value("Authorization") = "" oOptions.Value("Description") = oDoc.PropertySets.Item(3).Item("Description").Value oOptions.Value("Organization") = oDoc.PropertySets.Item(2).Item("Company").Value Try oSTEP.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium) Return True Catch Logger.Error("Error exporting following file to STEP file:" & vbCrLf & oDoc.FullFileName) Return False End Try Else Return False End If End Function