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

Hi, I tweak your code a bit, I think it's now what you're looking for. Please check it out and see if we can improve it. regards

 

 

Public Class RWEI_0001A
	Shared oTextSave As String = "C:\Users\Public\Documents\iLogicBuffer.txt"
	
Sub Main() 
	'Accessing Assembly Components @ https://modthemachine.typepad.com/my_weblog/2009/03/accessing-assembly-components.html
	Dim oDashes As String = ""
	Dim iL_NO As String = "0001A-BOM"
	Dim iL_Name As String = "All Occurrences with BOM Structure"
	Dim iL_FullName As String = "Rule " & iL_NO & ": " & iL_Name
	Dim oDoc As Document = ThisApplication.ActiveDocument
			
	oDelete_ex_Notepad(oTextSave, iL_NO)
	oHL1 = "FILE REFERENCE TREE RAN FROM: " & oDoc.FullFileName
	oWrite_HeaderLines(oTextSave, oHL1)
	oHL2 = iL_FullName
	oWrite_HeaderLines(oTextSave, oHL2)
	For i = 1 To Len(iL_FullName)
		oDashes = oDashes & "-"
	Next i
	oWrite_DashLine(oTextSave, oDashes)
	
    ' Get the active assembly. 
    Dim oAsmDoc As AssemblyDocument 
    oAsmDoc = ThisApplication.ActiveDocument 

    ' Call the function that does the recursion. 
    Call TraverseAssembly(oAsmDoc.ComponentDefinition.Occurrences, 1) 
	Process.Start("Notepad.exe", oTextSave)
End Sub 

Private Sub TraverseAssembly(Occurrences As ComponentOccurrences, Level As Integer) 
    ' Iterate through all of the occurrence in this collection.  This 
    ' represents the occurrences at the top level of an assembly. 
    Dim oOcc As ComponentOccurrence 
    For Each oOcc In Occurrences 
        ' Print the name of the current occurrence. 
        ' Check to see if this occurrence represents a subassembly 
        ' and recursively call this function to traverse through it. 
        If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then 
            Call TraverseAssembly(oOcc.SubOccurrences, Level + 1) 
        End If 
		
		Try
			Dim oParentocc As ComponentOccurrence
			oParentocc = oOcc.ParentOccurrence
			oParent = oParentocc.Name
		Catch
			oParent = System.IO.Path.GetFileNameWithoutExtension(oOcc.Parent.Document.DisplayName)
		End Try

		oData_X = oParent & "@" & oOcc.Name & "@" & "Level - " & Level
		oWrite_Data(oTextSave, oData_X)
	Next 
End Sub


Function GetOccurrenceParent(oOcc As ComponentOccurrence, oOccName As String)

	Return oOcc.Parent.Document.DisplayName
End Function


'Process.Start("Notepad.exe", oTextSave)	
Sub oWrite_Data(oTextSave As String, oData As String)
	oWrite = System.IO.File.AppendText(oTextSave)
	oWrite.WriteLine(oData)	
	oWrite.Flush()
	oWrite.Close
End Sub

Sub oWrite_HeaderLines(oTextSave As String, oHeaderLine As String)
	oWrite = System.IO.File.AppendText(oTextSave)
	oWrite.WriteLine(oHeaderLine)	
	oWrite.Flush()
	oWrite.Close
End Sub
	
Sub oWrite_DashLine(oTextSave As String, oDashes As String)
	oWrite = System.IO.File.AppendText(oTextSave)
	oWrite.WriteLine(oDashes)	
	oWrite.Flush()
	oWrite.Close
End Sub

Sub oDelete_ex_Notepad(oTextSave As String, iL_NO As String)		'To delete oTextSave if existing.
'	Dim FileDelete As String
'	FileDelete = "C:\testDelete.txt"
 	If System.IO.File.Exists(oTextSave) = True Then
   	System.IO.File.Delete(oTextSave)
	MessageBox.Show("Existing (if any) File Deleted", iL_NO)
	End If
End Sub
End Class

 


Please accept as solution and give likes if applicable.

I am attaching my Upwork profile for specific queries.

Sergio Daniel Suarez
Mechanical Designer

| Upwork Profile | LinkedIn