Copying GeoSets from tree structure to one part 1

[Telcontar]

I've got a Product Structure with under-products and parts within. Each part, among others, has got two GeoSets named: "Part_Geometry" and "RPS_Elements". My goal is to:

- copy "Part_Geometry" from every part
- paste special without link into the newly created part called MAIN.CATPart;
- rename "Part_Geometry" with name as PartName which it came from (Parent.name maybe?)
- copy "RPS_Elements" from every part and paste it without link into the MAIN.CATPart.

Sub CATMain()
Set documents1 = CATIA.Documents

' Part erstellung und umbennenung / part creation and naming

Set partDocument1 = documents1.Add("Part")

Set product1 = partDocument1.GetItem("Part5")

product1.PartNumber = "MAIN"


' Fensterbehandlung / window tilling

Set windows1 = CATIA.Windows

windows1.Arrange catArrangeTiledVertical

Set specsAndGeomWindow1 = windows1.item(1)

specsAndGeomWindow1.Activate 

dim Partset
dim Copyset
dim Hybridbody1
dim PasteSet

' Parts Collection

Set PartSet = CATIA.ActiveDocument.Selection
PartSet.clear

PartSet.search "(CATAsmSearch.Part),all"

'Loop fuer Geosets copy und paste / Loop for copy/paste
For i=1 to PartSet.Count

Set ActiveDocu = PartSet.Item(i)
Set ActivePart = ActiveDocu.Part

	
Set Hybridbodies = PartSet.Item(i).HybridBodies
Set Hybridbody1 = Hybridbodies.Item("RPS_Elements")
Set Hybridbody2 = Hybridbodies.Item("Part_Geometry")
Copyset.Add Hybridbody1
Copyset.Add Hybridbody2
Copyset.copy

Set specsAndGeomWindow2 = windows1.item(product1)

specsAndGeomWindow2.Activate

Set PasteSet = product1.selection
PasteSet.Add product1
PasteSet.PasteSpecial "CATPrtAsResult"
product1.Update

specsAndGeomWindow1.Activate 

next
product1.update
End Sub

Now I'm stuck on getting all Parts into selection (PartSet) and can't go further. Could someone please review and correct me?

Any comment would be appreciated

Best regard
Lucas

 

[ferdo]

Hi,

This is just to show how you can copy the GeoSets

Language="VBSCRIPT"

Sub CATMain()

Dim productDocument1 As Document
Set productDocument1 = CATIA.ActiveDocument

Dim selection2 As Selection
Set selection2 = productDocument1.Selection

selection2.Search "CATPrtSearch.OpenBodyFeature.Name=Part_Geometry,all"

Dim P As Selection
Set P = CATIA.ActiveDocument.Selection
P.Selection.Copy

Set documents1 = CATIA.Documents
Set partDocument1 = documents1.Add("Part")

	CATIA.StartCommand "Paste Special..."

End Sub

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[Telcontar]

Hello Fernando

Thank you for your response, but your method does not include renaming GeoSet between copy and paste operation. How can I achieve that?
I thought, that I should create a set of elements (parts) on which I will take actions, such copy or copy and rename appropriate GeoSet, and then paste this selection into target part... I remind you, that GeoSet named "Part_Geomerty" should be renamed to its Parent name (in this case with name of the part, from which it came )

Best regards

Lucas

 

[ferdo]

Hi,

Let me understand: you want to copy one by one the GS and paste (also one by one) in a new part and change the name of each GS copied with the name of the part from where was copied? That would be much more complicated...

Even better, can you post a result part of your action?

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[Telcontar]

That's almost what I need. Except one thing. Only GS named "part_geometry" must be renamed with name of the part from it came. part I will post resulting part on Monday. Have a nice weekend!

Lucas

 

[lardman363]

Are you writing this in VBA or catvbs/CATScript? It would be helpful if you made a list of the steps you want to accomplish. Usually you get one step of the macro to work, then move on to the next. So it sounds like you want to:
1. Find all the geosets in the assembly named Part_geometry and RPS_elements
2. Copy the geosets
3. Paste the geosets into another part called Main
4. Rename Part_geometry geoset with the name of the part it came from

If this is not correct, please revise.

Questions:
- Is the Main part an instance in the same assembly that holds all of the parts you are copying from or in a different window? Looks like you are creating it in a different window.
-Do the Part_geometry and RPS_elements geosets from each part need to stay grouped together in the Main part specification tree? As ferdo mentioned, you would have to copy/paste one-by-one.
-Would it be acceptable to paste the RPS_elements into the Part_geometry geoset? Based on how I understand your requirements, your spec tree would look like:
Main.CATPart
Part1
PS_elements
Part2
PS_elements
Part3
PS_elements
...and that doesn't seem right

Could you create geosets in the main part for each part in the assembly, then paste in the Part_geometry and RPS_elements into the appropriate geoset? You would have:
Main.CATPart
Part1
Part_geometry
PS_elements
Part2
Part_geometry
PS_elements
Part3
Part_geometry
PS_elements

 

[Telcontar]

Hi Lardman363

"1. Find all the geosets in the assembly named Part_geometry and RPS_elements
2. Copy the geosets
3. Paste the geosets into another part called Main
4. Rename Part_geometry geoset with the name of the part it came from"
That's what I want ;-)
It's VB script language. Main. Catpart is standalone part. Doesn't belong to the assembly.
"Main.CATPart
Part1
PS_elements
Part2
PS_elements
Part3
PS_elements"
That's exactly what I need main part must remain as simple as can be.
"Could you create geosets in the main part for each part in the assembly, then paste in the Part_geometry and RPS_elements into the appropriate geoset? You would have:
Main.CATPart
Part1
Part_geometry
PS_elements
Part2
Part_geometry
PS_elements
Part3
Part_geometry
PS_elements"
At this moment I's not necessary. Maybe later... ;-) ATM - no go.
Regards
Lucas

 

[Telcontar]

Here's screenshot of tree structure of the resulting part + CATPart.

One important update: Every GeoSet named Part_Geometry has a surface which should be named exactly the same way as Part_Name - the name of the part from where set came.

http://i57.tinypic.com/doa2zd.jpg[/IMG]]

 

[Telcontar]

Sorry to re-post

Last pic&file had little mistake (surface under GeoSet BLECH4 was not renamed). This is the right one.

http://i57.tinypic.com/mt9u1i.jpg[/IMG]]

 

[lardman363]

Since you are in vbs, you can try storing the selected parts in an array. Assuming everything else you had will work, I added to your script...did not test it.
Sub CATMain()
Set documents1 = CATIA.Documents

' Part erstellung und umbennenung / part creation and naming
Set partDocument1 = documents1.Add("Part")
Set product1 = partDocument1.GetItem("Part5")
product1.PartNumber = "MAIN"

' Fensterbehandlung / window tilling
Set windows1 = CATIA.Windows
windows1.Arrange catArrangeTiledVertical
Set specsAndGeomWindow1 = windows1.item(1)
specsAndGeomWindow1.Activate

dim Partset
dim Copyset
dim Hybridbody1
Dim Hybridbody2
dim PasteSet

' Parts Collection
Set PartSet = CATIA.ActiveDocument.Selection
PartSet.clear
PartSet.search "(CATAsmSearch.Part),all"

'Try storing the parts in an array, if you used VBA you could use a collection
'Loop and add selected parts to a collection
If PartSet.Count = 0 then 'there are no parts selected
MsgBox "No parts selected", vbCritical, "ERROR"
Else
iSelectedParts = PartSet.Count
Dim aParts(iSelectedParts)
For i = 0 to iSelectedParts
aParts(i) = PartSet.Item(i+1).value
Next
End if

'Loop fuer Geosets copy und paste / Loop for copy/paste
For i=0 to iSelectedParts 'CHANGED PartSet.Count
Set ActiveDocu = aParts(i)
Set ActivePart = ActiveDocu.Part
sName = ActivePart.Name 'capture name of part to rename geoset
Set Hybridbodies = ActiveDocu.HybridBodies
Set Hybridbody1 = Hybridbodies.Item("RPS_Elements")
Set Hybridbody2 = Hybridbodies.Item("Part_Geometry")
Copyset.Add Hybridbody1
Copyset.Add Hybridbody2
Copyset.copy

Set specsAndGeomWindow2 = windows1.item(product1)

specsAndGeomWindow2.Activate

Set PasteSet = product1.selection
PasteSet.Add product1
PasteSet.PasteSpecial "CATPrtAsResult"
PasteSet.Search "CATPrtSearch.OpenBodyFeature.Name=Part_Geometry,all"
Set oRenameBody = PasteSet.Item(1)
oRenameBody.Name = sName 'rename geoset to part
product1.Update

specsAndGeomWindow1.Activate

next
product1.update
End Sub

 

[lardman363]

I made a mistake, array counts start at 0 but the selection object's count starts at 1, so I had to adjust the values in the loop:

Sub CATMain()
Set documents1 = CATIA.Documents

' Part erstellung und umbennenung / part creation and naming

Set partDocument1 = documents1.Add("Part")

Set product1 = partDocument1.GetItem("Part5")

product1.PartNumber = "MAIN"

' Fensterbehandlung / window tilling

Set windows1 = CATIA.Windows

windows1.Arrange catArrangeTiledVertical

Set specsAndGeomWindow1 = windows1.item(1)

specsAndGeomWindow1.Activate

dim Partset
dim Copyset
dim Hybridbody1
Dim Hybridbody2
dim PasteSet

' Parts Collection

Set PartSet = CATIA.ActiveDocument.Selection
PartSet.clear

PartSet.search "(CATAsmSearch.Part),all"

'Try storing the parts in an array, if you used VBA you could use a collection
'Loop and add selected parts to a collection
If PartSet.Count = 0 then 'there are no parts selected
MsgBox "No parts selected", vbCritical, "ERROR"
Else
iSelectedParts = PartSet.Count
Dim aParts(iSelectedParts - 1)
For i = 0 to iSelectedParts - 1
aParts(i) = PartSet.Item(i+1).value
Next
End if

'Loop fuer Geosets copy und paste / Loop for copy/paste
For i=0 to iSelectedParts - 1 'CHANGED PartSet.Count
Set ActiveDocu = aParts(i) 'CHANGED PartSet.Item(i)
Set ActivePart = ActiveDocu.Part
sName = ActivePart.Name 'capture name of part to rename geoset
Set Hybridbodies = ActiveDocu.HybridBodies 'CHANGED PartSet.Item(i).HybridBodies
Set Hybridbody1 = Hybridbodies.Item("RPS_Elements")
Set Hybridbody2 = Hybridbodies.Item("Part_Geometry")
Copyset.Add Hybridbody1
Copyset.Add Hybridbody2
Copyset.copy

Set specsAndGeomWindow2 = windows1.item(product1)

specsAndGeomWindow2.Activate

Set PasteSet = product1.selection
PasteSet.Add product1
PasteSet.PasteSpecial "CATPrtAsResult"
PasteSet.Search "CATPrtSearch.OpenBodyFeature.Name=Part_Geometry,all"
Set oRenameBody = PasteSet.Item(1)
oRenameBody.Name = sName 'rename geoset to part
product1.Update

specsAndGeomWindow1.Activate

next
product1.update
End Sub

 

[Telcontar]

Hi lardman363

Sorry for not responding for a long time

I get an error on line 41:

Any idea what's wrong?

Best regards

 

[AlexLozoya]

try

Dim aParts()
ReDim aParts(iSelectedParts - 1)

______

Alex ,

 

[Telcontar]

Hi Alex

Thanks for your tip. Well, I goes one step forward:

Sorry - for Polish language - It's my homeland language it says:

Object does not support this property or method

Any idea what could cause that?

Regards

Lucas

 

[Telcontar]

I forgot to say, that this macro must work only as VBScript

 

[AlexLozoya]

try

[highlight #EF2929][b]Set[/b][/highlight] aParts(i) = PartSet.Item(i+1).value

______

Alex ,

 

[Telcontar]

I get one step further, but now I have the same problem with line 53

For i=0 to iSelectedParts - 1 'CHANGED PartSet.Count
Set ActiveDocu = aParts 'CHANGED PartSet.Item(i)
[COLOR=#CC0000]Set ActivePart = ActiveDocu.Part[/color]

Apparently problem lies in ActiveDocu - shouldn't that be collection of parts already?

 

[lardman363]

That is interesting, you shouldn't have to set aParts(i) because it is not an object. As for your last post, when you set ActiveDocu = something in an array, you have to put the position where it resides in the array. Try set ActiveDocu = aParts(i).

 

[Telcontar]

Hi lardman363

Thank you for your reply. However I do not follow you.... Didn't we (actually - you ) set ActiveDocu like you suggested already earlier?

'Loop fuer Geosets copy und paste / Loop for copy/paste
For i=0 to iSelectedParts - 1 'CHANGED PartSet.Count
[COLOR=#EF2929][b]Set ActiveDocu = aParts(i) 'CHANGED PartSet.Item(i)[/b][/color]
Set ActivePart = ActiveDocu.Part
sName = ActivePart.Name 'capture name of part to rename geoset
Set Hybridbodies = ActiveDocu.HybridBodies 'CHANGED PartSet.Item(i).HybridBodies
Set Hybridbody1 = Hybridbodies.Item("RPS_Elements")
Set Hybridbody2 = Hybridbodies.Item("Part_Geometry")
Copyset.Add Hybridbody1
Copyset.Add Hybridbody2
Copyset.copy

I tried to get this working in another way. Code below:

Sub CATMain()
'start by declaring the selection
Dim oSel
Set oSel = CATIA.ActiveDocument.Selection
'Create an array for CATParts
ReDim strArray(0)
strArray(0)="Part"

osel.Search "CATPrtSearch.PartFeature,all"

'Count the number of selected parts
iCount = oSel.Count

'Create a For Next loop to cycle through all selected parts
'Isn't vb scripting fun?
For i= 1 to iCount
Dim myObject2
Set myObject2 = oSel.Item(i).value
'Search only the selected objects for the object named "Part_Geometry"
oSel.Search "Name=Part_Geometry,sel"

'now we take all the Part_Geometry objects found and copy them
[COLOR=#CC0000][b]ReDim copies(iCount)
ReDim names(iCount)
For k=1 to iCount
Set copies(k)=oSel.Item(k).Value
Set names(k)=oSel.Item(k).Value.parent.parent.name
Set copies(k).name.value=names(k).value
oSel.Add copies(k)
oSel.Copy
'close the loops
Next 'k
Next 'i[/b][/color]


'Now use CATIA scripting basics to create a new part
Dim part2
Set part2 = CATIA.Documents.Add("CATPart")
Dim partDocument2 'As PartDocument
'rename the new part
part2.Product.PartNumber = "Hauptadapter"
'optional step: create a new geometrical set and rename it
'Dim GSet1 'As HybridBody
'Set GSet1 = part2.part.HybridBodies.Add ()
'GSet1.Name = "Flachen"
'set the newly create part to the active document
Set partDocument2= CATIA.ActiveDocument
Dim ActSel 'As Selection
Set ActSel=partDocument2.Selection
ActSel.Add partDocument2.Part   'GSet1
'paste special the Part_Geometry objects from the orginial file and paste as result without link
ActSel.PasteSpecial("CATPrtResultWithOutLink" )

'clear the selection
ActSel.Clear
End Sub

But I can't get copied GeoSets and surfaces having their parents name.... Maybe you could review this new code and give me some comments / hints?

 

[lardman363]

I thought you should not have to:
Set aParts(i) = PartSet.Item(i+1).value
aParts(i) is an array not an object, you only set objects. Looking at other sites, they too set the array...perhaps because you are storing objects in it? Sorry for any confusion.

http://www.coe.org/p/fo/et/thread=24797

As for Set ActiveDocu = aParts(i), ActiveDocu IS an object so you must SET it.

Regarding your code, you are searching for all parts and selecting them, then you do another search and you select all the "things" called "Part_Geometry" so now you have all the parts and all the things called "Part_Geometry" in your selection object. You really should store all the parts, then clear the selection, then collect your geometry.

In my experience, it is best to copy the geometry in the old geoset, then make a new geoset in the new part and paste the geometry into the new geoset. Also, don't Dim inside of a loop, you only need to dim once. Moreover, arrays start counting at 0 not 1...an array is like an excel table that has cells you store data in. This site has some good tutorials

http://www.w3schools.com/vbscript/func_array.asp.

'Create an array for CATParts
ReDim strArray(0) 'This is not needed you are not using a selection filter
strArray(0)="Part" 'This is not needed you are not using a selection filter
Dim copies()'Array for storing parts
Dim names()'Array for storing names

'search and store parts in array
osel.Search "CATPrtSearch.PartFeature,all"
iCount = oSel.Count
'Resize both arrays so they have the same number of "cells" as the count (remember arrays start at 0 not 1, so you have to -1 from the count)
ReDim copies(iCount-1)
ReDim names(iCount-1)

For i= 1 to iCount

Set copies(i-1)=oSel.Item(i).Value​

MsgBox copies(i-1).name'you should be able to check what is stored in the copies array with a messagebox​

names(i-1)=oSel.Item(i).Value.name 'you shouldnt need SET on this since they are strings​

MsgBox names(i-1)'check what is stored in the name array​

Next

oSel.Clear'Clear the selection when everything is stored

Once you are confident you have the correct parts stored in the copies array and the correct names of the parts stored in the names array, you can then
-Create your new part
-Create a geoset and name it in the new part
For i=1 to iCount

Set oNewGeoset = oPart.HybridBodies.Add​

oNewGeoset.Name = names(i-1)​

oSel.Add copies(i-1)​

oSel.Search "Name=Part_Geometry,sel"​

Set oOldGeoSet = oSel.Item(1)'Hopefully there is only one geoset with this name​

oSel.clear​

For k=1 to oOldGeoSet.HybridShapes.count​

oSel.add oOldGeoSet.HybridShapes.item(k)​

Next​

oSel.Copy​

oSel.Clear​

oSel.add oNewGeoSet​

oSel.PasteSpecial("CATPrtResultWithOutLink" )​

Next

You will likely need to activate the old document and the new document as you copy/paste...this is just to give you the idea.