copy geo sets from selection, to new parts

[LWolf]

thread560-367939
hello; I am trying to copy contents of selected GeoSets and paste it to separate Parts, one part for each selected Set. if my Selection consists of Main Set, and SubSet1 and SubSet2, I'd like to get three files, one containing the Main Set (and both SubSets), one with SubSet1 and one with SubSet2. so far I have something that I have copy-pasted from several threads, but I get three replicas of ALL the sets...

Sub CATMain()

Dim USel As Selection
Dim USelLB
Dim InputObject(0)
Dim oStatus
Dim oListBox

InputObject(0) = "HybridBody"
Set USel = CATIA.ActiveDocument.Selection
Set USelLB = USel

USel.Clear

oStatus = USelLB.SelectElement3(InputObject, "Select objects to list names", True,CATMultiSelTriggWhenUserValidatesSelection, False)

If (oStatus = "Cancel") Then 'User hit esc on keyboard
MsgBox "Macro canceled by user"
Exit Sub
Else 'Loop through selected objects and copy contents
For i = 1 to USel.Count

Set oSet = USel.Item(i).Value
For Each s In oSet.HybridShapes

USel.Add s
USel.Copy ' Copy the Geometry
USel.Clear ' Clear the selection

' create second part

Dim part2
Set part2 = CATIA.Documents.Add("CATPart") ' Makes a new CATPart and thusly, new actdoc
Set ActDoc = CATIA.ActiveDocument ' New ActDoc

' Retrieving HybridBodies collection in Part Document

Dim hybridBodies2 As HybridBodies
Set hybridBodies2 = part2.Part.HybridBodies

Dim GSet1 As HybridBody

Set GSet1 = part2.Part.HybridBodies.Item(1)
Set USel = ActDoc.Selection ' Create an object of selection for the Target document
USel.Add GSet1 ' Add the Set where the copied data will be pasted in the selection
USel.PasteSpecial("CATPrtResultWithOutLink")

Next
Next
End If
USel.Clear
End Sub

regards,
LWolf

 

[lardman363]

Without seeing the part, I cant understand what you mean by getting 3 duplicates of all the sets.

One issue is you create a new part inside of the loop where you copy the geometry, so you should be getting a new part for every feature inside of the geoset.

It sounds like if there are no embedded geosets, you just want to explicitly paste all the features in the source geoset into the first geoset in the newly created target part.

If there are embeded geosets, you want to have a new geoset added to the target part with the same name as the source geoset, then paste explicitly into that geoset.

No guarantees it will work (I did not test it...BTW I hate how posting doesn't keep tabs), but try something like this:

Sub CATMain()
'Declare and set for Source part
Dim oPartDoc1 as PartDocument
Dim USel As Selection
Dim USelLB
Dim InputObject(0)
Dim oStatus
Dim cSelectedSets as new collection
Dim cEmbeddedSets as new collection

Set oPartDoc1 = CATIA.ActiveDocument
Set USel = oPartDoc1.Selection
Set USelLB = USel
InputObject(0) = "HybridBody"

'Declare and set for Target part
Dim oPart2 As Part
Dim oPartDoc2 as PartDocument
Dim USel2 As Selection
Dim hybridBodies2 As HybridBodies
Dim GSet1 As HybridBody

'Code
USel.Clear

oStatus = USelLB.SelectElement3(InputObject, "Select objects to list names", True,CATMultiSelTriggWhenUserValidatesSelection, False)

If (oStatus = "Cancel") Then 'User hit esc on keyboard
MsgBox "Macro canceled by user"
Exit Sub
Else 'Loop through selected objects and copy contents

'Add selected geosets to a collection
For i = 1 to USel.Count
cSelectedSets.add USel.item(I).value
Next
USel.Clear

For i=1 to cSelectedSets.count
' create second part for every geoset selected
Set oPartDoc2 = CATIA.Documents.Add("CATPart") ' Makes a new CATPart
Set oPart2 = oPartDoc2.Part
Set USel2 = oPartDoc2.Selection ' Create an object of selection for the Target document
Set hybridBodies2 = oPart2.HybridBodies



If cSelectedSets.Item(i).hybridbodies.count > 0 then 'if there are embedded geosets add them to a new collection

'Clear the collection of embedded geosets so it can be repopulated
iCounter = 1
do while cEmbeddedSets.count > 0
cEmbeddedSets.Remove 1
iCounter = iCounter + 1
If iCounter = 999
exit do 'Prevents infinite loop
end if
loop

cEmbeddedSets.add cSelectedSets.Item(i)
For j = 1 to cSelectedSets.Item(i).hybridbodies.count
cEmbeddedSets.add cSelectedSets.Item(i).hybridbodies.item(j)
Next

'Loop through embedded sets
For j = 1 to cEmbeddedSets.count
Set oSet = cEmbeddedSets.Item(j)
sName = oSet.Name

Set GSet1 = hybridBodies2.Add 'add new geoset to 2nd part with same name as geoset in first part
GSet1.name = sName

For Each s In oSet.HybridShapes
'Copy geometry from source part
USel.Add s
USel.Copy ' Copy the Geometry
USel.Clear ' Clear the selection

'Paste into target part
USel2.Add GSet1 ' Add the Set where the copied will be pasted in the selection
USel2.PasteSpecial("CATPrtResultWithOutLink") data
USel2.clear
Next
Next
Else 'If there are no embeded geosets, paste geometry into first geoset in target part
Set oSet = cSelectedSets.Item(i)
For Each s In oSet.HybridShapes
USel.Add s
USel.Copy ' Copy the Geometry
USel.Clear ' Clear the selection

Set GSet1 = hybridBodies2.Item(1)
USel2.Add GSet1 ' Add the Set where the copied will be pasted in the selectiondata
USel2.PasteSpecial("CATPrtResultWithOutLink")
USel2.clear
Next
End if
Next
end if
USel.Clear
USel2.Clear
End Sub