Ilogic rule for sort subassemblies in main assembly

[b_art_construction11]

Hello everybody,

I'm wondering that it will be a possible to create a rule which will sort all subasemblies for marked one of them and will automaticlu create a folder (with same name like subasemblies) and then moved all subassemblies to one floder. I dont want to searching of all tree subasemblies and manually marked them to created a folder. Is it possible? 

Regards

[havlat_prefaservis · Accepted solution]

Hello, its quick but working code. There is definitely room for improvement, but it does the job....:

Sub Main()
    ' Reference to the active assembly document
    Dim assemblyDoc As AssemblyDocument = ThisApplication.ActiveDocument

      If ThisApplication.ActiveEditDocument IsNot Nothing Then
	        assemblyDoc = ThisApplication.ActiveEditDocument
      End If

    Dim assemblyDef As AssemblyComponentDefinition = assemblyDoc.ComponentDefinition
    Dim browserPane As BrowserPane = assemblyDoc.BrowserPanes.ActivePane
    
    ' Loop for continuous selection
    Do
        ' 1. Prompt user to pick a component
        Dim pickedObject As Object = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllEntitiesFilter, "Select a component to group (ESC to exit)")
        
        ' Exit if user cancels or hits ESC
        If pickedObject Is Nothing Then Exit Sub
        
        ' 2. Extract the base name (removing the instance index after ":")
        Dim occurrenceName As String = ""
        If TypeOf pickedObject Is ComponentOccurrence Then
            occurrenceName = CType(pickedObject, ComponentOccurrence).Name
        Else
            occurrenceName = pickedObject.Name
        End If
        
        Dim folderName As String = occurrenceName.Split(":")(0)
        
        ' 3. Remove existing folder with the same name to refresh contents
        Try
            Dim existingFolder As BrowserFolder = browserPane.TopNode.BrowserFolders.Item(folderName)
            existingFolder.Delete
        Catch
            ' Folder does not exist, proceed
        End Try
        
        ' 4. Gather all occurrences matching the base name
        Dim occurrenceCollection As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
        
        For Each occ As ComponentOccurrence In assemblyDef.Occurrences
            ' Match names that start with "FolderName:" or match the name exactly
            If occ.Name.StartsWith(folderName & ":") Or occ.Name = folderName Then
                Dim browserNode As BrowserNode = browserPane.GetBrowserNodeFromObject(occ)
                If browserNode IsNot Nothing Then
                    occurrenceCollection.Add(browserNode)
                End If
            End If
        Next
        
        ' 5. Create folder and move the collected nodes
        If occurrenceCollection.Count > 0 Then
            Try
                Dim newFolder As BrowserFolder = browserPane.AddBrowserFolder(folderName, occurrenceCollection)
                newFolder.BrowserNode.DoSelect
            Catch ex As Exception
                MessageBox.Show("Failed to create folder: " & ex.Message, "Browser Organizer")
            End Try
        End If
    Loop
End Sub

To use it, simply run the rule and select the component directly in the browser tree...

[WCrihfield]

Here is the version I was working on...even though it is a few minutes late.  I did not have time to test it, because I am on my way out for the day.  I will check back tomorrow, if time & opportunity permit.

Sub Main
	'get Inventor's 'active' document, then try to Cast it to the  AssemblyDocument Type
	Dim oADoc As AssemblyDocument = TryCast(ThisApplication.ActiveDocument, Inventor.AssemblyDocument)
	'if that failed, then the variable did not get a value assigned to it, so exit rule
	If oADoc Is Nothing Then Return
	'get the 'Model' pane by its InternalName (same for all languages)
	Dim oModelPane As Inventor.BrowserPane = oADoc.BrowserPanes.Item("AmBrowserArrangement")
	Dim oTopNodes As Inventor.BrowserNodesEnumerator = oModelPane.TopNode.BrowserNodes
	
	'create a Dictionary for grouping browser nodes by their 'base name'
	'the 'Key' of each entry will be a String (the 'base name')
	'the 'Value' of each entry will be an ObjectCollection of the browser nodes
	Dim oGroupsDict As Dictionary(Of String, Inventor.ObjectCollection) = _
	New Dictionary(Of String, Inventor.ObjectCollection)
	
	'create a collection to store sub assembly component browser nodes in
	Dim oSubAssyNodesColl As Inventor.ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection()
	'iterate through all 'top level only' browser nodes, in their top to bottom order
	For i As Integer = 1 To oTopNodes.Count
		'get the browser node at this Index position
		Dim oBNode As Inventor.BrowserNode = oTopNodes.Item(i)
		'get the object that this browser node represents
		Dim oNObj As Object = Nothing
		'accessing this property can fail with an error
		Try : oNObj = oBNode.NativeObject : Catch : End Try
		If oNObj Is Nothing Then Continue For
		'if it represents a component, then get that component to a variable
		Dim oOcc As Inventor.ComponentOccurrence = Nothing
		oOcc = TryCast(oNObj, Inventor.ComponentOccurrence)
		If oOcc Is Nothing Then Continue For
		'if it is suppressed, then skip over it
		If oOcc.Suppressed Then Continue For
		'if it does not represent an assembly, then skip over it
		If Not oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then Continue For
		'get this component's base name
		Dim sBaseName As String = oOcc.Name
		'get only the portion of the name before the ":" character (if it contains that character)
		If sBaseName.Contains(":") Then sBaseName = sBaseName.Split(":").First()
		'add this browser node to our dictionary, grouped appropriately
		If oGroupsDict.ContainsKey(sBaseName) Then
			oGroupsDict.Item(sBaseName).Add(oBNode)
		Else
			Dim oObjColl As Inventor.ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection()
			oObjColl.Add(oBNode)
			oGroupsDict.Add(sBaseName, oObjColl)
		End If
	Next 'i
	
	If oGroupsDict.Count = 0 Then Exit Sub
	For Each oEntry As KeyValuePair(Of String, Inventor.ObjectCollection) In oGroupsDict
		'validate entry (avoid odd errors)
		If String.IsNullOrWhiteSpace(oEntry.Key) Then Continue For
		If oEntry.Value Is Nothing OrElse oEntry.Value.Count = 0 Then Continue For
		'define name for the folder - based on component 'base name'
		Dim sFolderName As String = oEntry.Key
		'get or create a BrowserFolder to put these nodes into
		Dim oFolder As Inventor.BrowserFolder = Nothing
		Try
			'try to find existing browser folder with specified name
			oFolder = oModelPane.TopNode.BrowserFolders.Item(sFolderName)
			'try to add nodes into the found folder
			For Each oBNode As BrowserNode In oEntry.Value
				Try : oFolder.Add(oBNode) : Catch : End Try
			Next 'oBNode
		Catch
			'create the browser folder, since it was not found, and supply its contents
			oFolder = oModelPane.AddBrowserFolder(sFolderName, oEntry.Value)
		End Try
	Next 'oEntry
	'update the model browser pane
	oModelPane.Update()
End Sub

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.