How to move items to a geometrical set with macro.

[Alexander888]

Can anyone know how to append preselected items to a geometrical set?

Basically macro should take the preselected items and then place them in a new Geo Set called 'CG' and put this 'CG' geo. set into the item's parent Geometrical set.

In other words, we will select items in the tree that are inside a geometrical set. We run the macro. Macro will create a geoset called 'CG' inside the parent geoset, and moves all selected features into this 'CG' geo set.

This is my current code that is not working.

Sub CATMain()
    ' Get the CATIA application object
    Dim CATIAApp
    Set CATIAApp = GetObject("", "CATIA.Application")
    
    ' Get the active document
    Dim doc
    Set doc = CATIAApp.ActiveDocument
    
    ' Get the selection object
    Dim selection
    Set selection = doc.Selection
    
    ' Ensure that items are selected
    If selection.Count = 0 Then
        MsgBox "Please select geometrical items."
        Exit Sub
    End If

    ' Get the first selected item to determine the parent geometrical set
    Dim firstSelectedItem
    Set firstSelectedItem = selection.Item(1).Value

    ' Find the parent geometrical set
    Dim parentSet
    Set parentSet = firstSelectedItem.Parent.Parent

    ' Create a new geometrical set called 'CG' inside the parent geometrical set
    Dim hybridBody
    Set hybridBody = parentSet.HybridBodies.Add
    hybridBody.Name = "CG"
    
    ' Loop through the selected items and move them to the new 'CG' geometrical set
    Dim i
    For i = 1 To selection.Count
        Dim selectedItem
        Set selectedItem = selection.Item(i).Value
        
        ' Append the selected item to the new 'CG' geometrical set
        hybridBody.AppendHybridShape selectedItem
    Next

    ' Update the document to reflect the changes
    doc.Part.Update
    
    MsgBox "Selected items moved to new geometrical set 'CG' inside " & parentSet.Name

End Sub

Error message says that the method AppendHybridShape failed at line 40 col. 8.

Thanks for the help in advance. Got stuck here badly.

 

[Little Cthulhu]

You can't use AppendHybridShape nor InsertHybridShape methods with feqtures that are already present in specification tree.

Use Selection.Cut and Selection.Paste instead.

 

[Alexander888]

Thank you for your help!

I tried it with your suggested method. Cutting and then pasting.
It works, but with this method, if the elements that we are moving have child components outside the selection, those outside elements will loose their link with the .Cut operation.

That was the code I tried.

Sub CATMain()
    ' Get the CATIA application object
    Dim CATIAApp
    Set CATIAApp = GetObject("", "CATIA.Application")
    
    ' Get the active document
    Dim doc
    Set doc = CATIAApp.ActiveDocument
    
    ' Get the selection object
    Dim selection
    Set selection = doc.Selection
    
    ' Ensure that items are selected
    If selection.Count = 0 Then
        MsgBox "Please select geometrical items."
        Exit Sub
    End If

    ' Get the first selected item to determine the parent geometrical set
    Dim firstSelectedItem
    Set firstSelectedItem = selection.Item2(1).Value

    ' Find the parent geometrical set
    Dim parentSet
    Set parentSet = firstSelectedItem.Parent.Parent

    ' Create a new geometrical set called 'CG' inside the parent geometrical set
    Dim hybridBody
    Set hybridBody = parentSet.HybridBodies.Add
    hybridBody.Name = "CG"
    
    ' Loop through the selected items, cut them from their current location, and paste them into the new 'CG' geometrical set
    Dim i
    For i = 1 To selection.Count
        ' Select the current item
        Dim selectedItem
        Set selectedItem = selection.Item2(i).Value
        
        ' Clear the selection, add the current item to the selection, cut it, and then paste it into the new 'CG' geometrical set
        selection.Clear()
        selection.Add selectedItem
        selection.Cut()
        selection.Clear()
        selection.Add hybridBody
        selection.Paste()
    Next

    ' Update the document to reflect the changes
    doc.Part.Update
    
    MsgBox "Selected items moved to new geometrical set 'CG' inside " & parentSet.Name

End Sub

Is there any other way to move elements to a geometrical set? While making sure that the child elements of these elements won't loose their links to them.

 

[Little Cthulhu]

Not possible with automation.