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

Hello

 

Exporting the BOM is not much work to do.

 

Option Explicit On
Sub Main()

'check that the active document is an assembly file
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
	MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
	Exit Sub
End If

Dim oAsmDoc As AssemblyDocument = ThisDoc.Document
Dim sAsmName As String = System.IO.Path.GetFileNameWithoutExtension(oAsmDoc.FullFileName )
Dim sFolder As String = "C:\Users\STEFANIA\Desktop\Nuova cartella (3)" & "\" & sAsmName & " STEP Files"

Dim STEPTranslator As TranslatorAddIn
Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
Dim oDataMedium As DataMedium  = ThisApplication.TransientObjects.CreateDataMedium
Call ConfigureSTEPTranslatorSettings(STEPTranslator, oContext, oOptions, oDataMedium)

If Not System.IO.Directory.Exists(sFolder) Then
	System.IO.Directory.CreateDirectory(sFolder)
End If

'look at the files referenced by the assembly
Dim oRefDoc As Document
For Each oRefDoc In oAsmDoc.AllReferencedDocuments
	If Not oRefDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then Continue For
	'get all occurrences of the referenced file, if one on them is visible - export that file to STEP, otherwise skip
	Dim oOccs As ComponentOccurrencesEnumerator = oAsmDoc.ComponentDefinition.Occurrences.AllReferencedOccurrences(oRefDoc)
	Dim oOcc As ComponentOccurrence
	Dim bVis As Boolean = False
	For Each oOcc In oOccs
		If oOcc.Visible 
			bVis = True
			Exit For
		End If
	Next
	
	If bVis = False Then
		Continue For 'Next For
	End If
	
	'check that model is saved
	If(System.IO.File.Exists(oRefDoc.FullDocumentName)) Then
		Dim sFilename As String = System.IO.Path.GetFileNameWithoutExtension(oRefDoc.FullDocumentName)
		Dim sDesc As String = oRefDoc.PropertySets.Item("Design Tracking Properties").Item("Description").Value
		Parameter.Quiet = True
		Dim sSospensione As String = Parameter("sospensione")
		oDataMedium.FileName = sFolder & "\" & sFilename & "_" & sSospensione & sDesc & ".stp"
		
		Try
			Call STEPTranslator.SaveCopyAs(oRefDoc, oContext, oOptions, oDataMedium)
		Catch
			MsgBox("Export of " & oRefDoc.DisplayName & " failed. Continue next one", MsgBoxStyle.Critical)
		End Try
	End If
Next

ExportBOM(oAsmDoc, sFolder)

MessageBox.Show("New Files Created in: " & vbLf & sFolder, "iLogic")
Shell("explorer.exe " & sFolder,vbNormalFocus)
End Sub


Sub ConfigureSTEPTranslatorSettings(ByRef oSTEPTranslator As TranslatorAddIn, ByRef oContext As TranslationContext, ByRef oOptions As NameValueMap, ByRef oDataMedium As DataMedium)
	oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")

	If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then
		' Set application protocol.
		' 2 = AP 203 - Configuration Controlled Design
		' 3 = AP 214 - Automotive Design
		oOptions.Value("ApplicationProtocolType") = 3
		' Other options...
		'oOptions.Value("Author") = ""
		'oOptions.Value("Authorization") = ""
		'oOptions.Value("Description") = ""
		'oOptions.Value("Organization") = ""
		oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
		oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
		'oDataMedium.FileName = ThisDoc.PathAndFileName(False) & ".stp"
	End If
End Sub

Sub ExportBOM(ByVal oAsmDoc As AssemblyDocument, ByVal sFolder As String)
	Dim oBOM As Inventor.BOM = oAsmDoc.ComponentDefinition.BOM
	oBOM.PartsOnlyViewEnabled = True
	Dim oBOMView As Inventor.BOMView
	For Each oBOMView In oBOM.BOMViews
		If oBOMView.ViewType=BOMViewTypeEnum.kPartsOnlyBOMViewType Then Exit For	
	Next
	
	If oBOMView IsNot Nothing Then
		oBOMView.Export(sFolder & "\" & "BOM.xls",FileFormatEnum.kMicrosoftExcelFormat)
	End If
	
End Sub

	

 


R. Krieg
RKW Solutions
www.rkw-solutions.com