Explode all sub-assemblies

[rbertoletti]

Hi guys,

i'm looking for a rule able to explode all sub assemblies in order to have only single parts in the "main assembly".

Thanks in advance.

[Andrii_Humeniuk]

Hi @rbertoletti . Please try this code. But it does not process patterns.

Sub main
	Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
	Dim oDef As AssemblyComponentDefinition = oDoc.ComponentDefinition
	Dim oPane As BrowserPane = oDoc.BrowserPanes.Item("Model")
	Dim oOccs As ComponentOccurrences = oDef.Occurrences
	ReturnStep :
	For Each oOcc As ComponentOccurrence In oOccs
		Dim oRefDoc As Document = oOcc.Definition.Document
		If oRefDoc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject _
			Or Not oRefDoc.IsModifiable Then Continue For
		For Each oSubOcc As ComponentOccurrence In oOcc.SubOccurrences
		    Dim oSourceNode As BrowserNode
		    oSourceNode = oPane.GetBrowserNodeFromObject(oSubOcc)
		    Try : Call oPane.Reorder(oTargetNode, True, oSourceNode) : Catch : End Try
		Next
		oOcc.Delete()
	Next
	If HasSubAsm(oOccs) Then GoTo ReturnStep
End Sub

Private Function HasSubAsm(ByVal oOccs As ComponentOccurrences) As Boolean
	For i As Integer = 1 To oOccs.Count
		If oOccs(i).DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then Return True
	Next i
	Return False
End Function

[rbertoletti]

I tested it, but seems that the code delete the sub-assemblies and not explode.

[Andrii_Humeniuk]

Sorry, I made one small mistake. Try this code:

Sub main
	Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
	Dim oDef As AssemblyComponentDefinition = oDoc.ComponentDefinition
	Dim oPane As BrowserPane = oDoc.BrowserPanes.Item("Model")
	Dim oOccs As ComponentOccurrences = oDef.Occurrences
	ReturnStep :
	For Each oOcc As ComponentOccurrence In oOccs
		Dim oRefDoc As Document = oOcc.Definition.Document
		If oRefDoc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject _
			Or Not oRefDoc.IsModifiable Then Continue For
		Dim oTargetNode As BrowserNode = oPane.GetBrowserNodeFromObject(oOcc)
		For Each oSubOcc As ComponentOccurrence In oOcc.SubOccurrences
		    Dim oSourceNode As BrowserNode
		    oSourceNode = oPane.GetBrowserNodeFromObject(oSubOcc)
		    Try : Call oPane.Reorder(oTargetNode, True, oSourceNode) : Catch : End Try
		Next
		oOcc.Delete()
	Next
	If HasSubAsm(oOccs) Then GoTo ReturnStep
End Sub

Private Function HasSubAsm(ByVal oOccs As ComponentOccurrences) As Boolean
	For i As Integer = 1 To oOccs.Count
		If oOccs(i).DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then Return True
	Next i
	Return False
End Function

[rbertoletti]

Ok, now it works great! I've also found that if i have some components which has the same name the duplicated are deleted.
In order to avoid this is it possible to rename all the components inside the sub-assemblies by adding as prefix the sub-assembly name?
In this case i think no one of them will be deleted.

Thanks

[Andrii_Humeniuk · Accepted solution]

Try this code:

Sub main
	Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
	Dim oDef As AssemblyComponentDefinition = oDoc.ComponentDefinition
	Dim oPane As BrowserPane = oDoc.BrowserPanes.Item("Model")
	Dim oOccs As ComponentOccurrences = oDef.Occurrences
	Dim oTM As Transaction = ThisApplication.TransactionManager.StartTransaction(oDoc, "Explode Assembly")
	ReturnStep :
	For Each oOcc As ComponentOccurrence In oOccs
		Dim oRefDoc As Document = oOcc.Definition.Document
		If oRefDoc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject _
			Or Not oRefDoc.IsModifiable Then Continue For
		Dim oTargetNode As BrowserNode = oPane.GetBrowserNodeFromObject(oOcc)
		For Each oSubOcc As ComponentOccurrence In oOcc.SubOccurrences
			If oSubOcc.DefinitionDocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
				Try : oSubOcc.Name = oOcc.Name & " - " & oSubOcc.Name :	Catch : End Try
			End If
		    Dim oSourceNode As BrowserNode
		    oSourceNode = oPane.GetBrowserNodeFromObject(oSubOcc)
		    Try : Call oPane.Reorder(oTargetNode, True, oSourceNode) : Catch : End Try
		Next
		oOcc.Delete()
	Next
	If HasSubAsm(oOccs) Then GoTo ReturnStep
	oTM.End()
End Sub

Private Function HasSubAsm(ByVal oOccs As ComponentOccurrences) As Boolean
	For i As Integer = 1 To oOccs.Count
		If oOccs(i).DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then Return True
	Next i
	Return False
End Function

The new name of the component is written in line 15.

[dipranjan]

please give code for reassembly of all explode sub assembly.

[chris]

What is the use case for this?

[dipranjan]

Dear Sir, 

I have huge assemblies. I want to explode the all-sub assembly. And again, assemble all assembly to show the clients as different part.