Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

Catia Macro Selection to copy and paste multiple PartBody objects into new CATPart

Status
Not open for further replies.

Kattmandu

Automotive
Oct 31, 2022
7
0
0
US
I found this "Catia Macro Selection" code online and modified it a bit to learn more about CATScripts. The original code assumes that there is only one PartBody in each CATPart. I am trying to modify it so that it will copy multiple PartBody objects in each selected CATPart. The modified code below works if all of the PartBody object are not empty (have some sort of CAD data in them). If any of the PartBody objects are empty, none of the other valid PartBody objects are pasted-as-result-without-link into the newly created CATPart. What is the solution to fix this? Is there a way to deselect one of multiple selected PartBody objects? I was thinking oSel.Remove bodies1(k) but .Remove doesn't appear to be valid.


Code:
Sub CATMain()

[COLOR=#CC0000]Dim oSel As Selection
Set oSel = CATIA.ActiveDocument.Selection[/color]

'Create an array for CATParts
ReDim strArray(0)
strArray(0)="Part"

'Display a messagebox prompting the user to select CATIA parts
Dim sStatus As String
Msgbox "Please select parts to join."

'Allow user to select multiple parts from the spec tree or the Interactive area
sStatus = oSel.SelectElement3(strArray, "Select parts", False, CATMultiSelTriggWhenUserValidatesSelection, false)

'Count the number of selected parts
partCount1 = oSel.Count
MsgBox "You have selected " & partCount1 & " part(s)."

'Create a For…Next loop to cycle through all selected parts
For i= 1 to partCount1
Dim myObject2
Set myObject2 = oSel.Item(i).value

'Search the selected objects for only the object type "Body"
[COLOR=#CC0000]oSel.Search "Type=Body,sel"[/color]

'Count the number of selected body objects
[COLOR=#CC0000]bodyCount1 = oSel.Count[/color]
MsgBox "Part " & partCount1 & " has " & bodyCount1 & " selected body object(s)."

'Create a For…Next loop to cycle through all selected body objects
[COLOR=#CC0000]For k=1 to bodyCount1
ReDim bodies1(bodyCount1)
Set bodies1(k)=oSel.Item(k).Value[/color]

'Copy all the body objects found
y=bodies1(k).Shapes.Count + bodies1(k).HybridBodies.Count + bodies1(k).Sketches.Count
If (y = 0) Then
[COLOR=#73D216][b]'Maybe create script to deselect empty PartBody???[/b][/color]
MsgBox "Did not add body object """ & bodies1(k).Name & """ from part " & i & " to copy because it's empty."
ElseIf Not (bodies1(k).InBooleanOperation = False) Then
MsgBox "Did not add body object """ & bodies1(k).Name & """ from part " & i & " to copy because it's Boolean."
Else
[COLOR=#CC0000]oSel.Add bodies1(k)
oSel.Copy[/color]
MsgBox "Added body object """ & bodies1(k).Name & """ from part " & i & " to copy."
End If

'Close the loops
[COLOR=#CC0000]Next 'k[/color]
Next 'i

'Create a new part
Dim part2
Set part2 = CATIA.Documents.Add("CATPart")
Dim partDocument2 As PartDocument

'Rename the new part
part2.Product.PartNumber = "My New Part"

'Create a new PartBody and rename it
Dim body1 As Body
Set body1 = part2.Part.Bodies.Item(1)
body1.Name = "My New PartBody"

'Set the newly created PartBody to the active object
Set part2 = part2.Product.Parent.Part
part2.InWorkObject = body1

'Set the newly created part to the active document
Set partDocument2= CATIA.ActiveDocument
Dim ActSel As Selection
Set ActSel=partDocument2.Selection
ActSel.Add body1

'Paste special the PartBody objects from the orginial file and paste as result without link
[COLOR=#CC0000]ActSel.PasteSpecial("CATPrtResultWithOutLink")[/color]

'Clear the selection
ActSel.Clear

End Sub

 
Replies continue below

Recommended for you

Status
Not open for further replies.
Back
Top