Paste as part body macro

[mrawlinc]

Hi,

I have macro which generates parts (and assembly of new parts) from each body in multy-body part, but they are pasted as normal (second) body. What would like is that this new (pasted) body would be Part Body. any ideas?

 

[itsmyjob]

add few line (one might be enough) to the script to make the new pasted body the main body.

Eric N.
indocti discant et ament meminisse periti ​

 

[LWolf]

CATIA.ActiveDocument.Part.MainBody

regards,
LWolf

 

[mrawlinc]

I managed to "convert" newly pasted body to Part Body:

Set partDocument2 = CATIA.ActiveDocument
Set specsAndGeomWindow1 = CATIA.ActiveWindow
Set part2 = partDocument2.Part

  sel.Add part2
  sel.PasteSpecial ("CATPrtResult")
  part2.MainBody = part2.Bodies.Item(2)
  part2.Update

now I would like delete first (empty) body, but simply adding to selection and delete doesn't work in this case...

Set partDocument2 = CATIA.ActiveDocument
Set specsAndGeomWindow1 = CATIA.ActiveWindow
Set part2 = partDocument2.Part

  sel.Add part2
  sel.PasteSpecial ("CATPrtResult")
  part2.MainBody = part2.Bodies.Item(2)
  part2.Update
  sel.Clear
  sel.Add part2.Bodies.Item(1)
  sel.Delete
  sel.Clear

 

[itsmyjob]

check again your bodies collection. I have the feeling that when you define one body as main body it become bodies.item(1)

that would explain why nothing happens in your case as you can not delete main body.

If I am correct simply change to

[...]
sel.Add part2.Bodies.Item([COLOR=#EF2929][b]2[/b][/color])
sel.Delete
[...]

Eric N.
indocti discant et ament meminisse periti ​

 

[mrawlinc]

I tried this way, as default (empty) body name is always the same, but also nothing happened...

sel.Add part2.Bodies.Item("Body.1")  
sel.Delete
sel.Clear

 

[mrawlinc]

It might help if I paste entire macro code, so you can test it (bottom third is where body delete should happen):

Sub CATMain()

Dim i, n As Integer

Dim name, prt As String

Dim BodyName() As String

Dim partDocument1 As PartDocument

On Error Resume Next

Set partDocument1 = CATIA.ActiveDocument

If Err.Description = "Type mismatch" Then

      MsgBox "You must have a CATPart as active document"

    Exit Sub

End If

name = partDocument1.FullName

Dim part1 As Part

Set part1 = partDocument1.Part

Dim bodies1 As Bodies

Set bodies1 = part1.Bodies

Dim body1 As Body

Dim sel As Selection

Set sel = partDocument1.Selection

Dim documents2 As Documents

Dim partDocument2 As PartDocument

Dim part2 As Part

Dim specsAndGeomWindow1 As SpecsAndGeomWindow

n = bodies1.Count

If n = 1 Then

  MsgBox "There is only one body in:" & Chr(13) & name & Chr(13) & "Part MUST have at least 2 Body's" & Chr(13) & "Macro will end now!!!", vbExclamation, "Warning"

Exit Sub

End If

prt = Left(partDocument1.name, Len(partDocument1.name) - 8)

For i = 1 To n

ReDim Preserve BodyName(i)

  'BodyName(i) = prt & "_" & bodies1.Item(i).name
  BodyName(i) = bodies1.Item(i).name

Set partDocument1 = CATIA.ActiveDocument

  sel.Clear

  sel.Add bodies1.Item(i)

  sel.Copy

Set documents2 = CATIA.Documents

Set partDocument2 = documents2.Add("Part")

  partDocument2.Product.PartNumber = BodyName(i)

Set partDocument2 = CATIA.ActiveDocument

Set specsAndGeomWindow1 = CATIA.ActiveWindow

Set part2 = partDocument2.Part

  sel.Add part2

  sel.PasteSpecial ("CATPrtResult")
  
  part2.MainBody = part2.Bodies.Item(2)
    
  part2.Update
  
'---------------- Where delete of empty body sould happen
  
  sel.Clear
  
  sel.Add part2.Bodies.Item(1)
  
  sel.Delete
  sel.Clear

'-----------------------------------------
  
Set partDocument2 = CATIA.ActiveDocument

  partDocument2.SaveAs Left(name, Len(name) - Len(partDocument1.name)) & BodyName(i) & ".CATPart"

  specsAndGeomWindow1.Close

  partDocument2.Close

Next 'i

Dim documents1 As Documents

Set documents1 = CATIA.Documents

Dim productDocument1 As ProductDocument

Set productDocument1 = documents1.Add("Product")

productDocument1.Product.PartNumber = "Product_From_Part_" & Left(partDocument1.name, Len(partDocument1.name) - 8)

Dim product1 As Product

Set product1 = productDocument1.Product

Dim products1 As Products

Set products1 = product1.Products

Dim arrayOfVariantOfBSTR1(0)

Dim constraints1 As Constraints

Set constraints1 = product1.Connections("CATIAConstraints")

Dim reference1 As Reference

Dim constraint1 As Constraint

Dim ConString As String

 

For i = 1 To n

  ConString = ""

  ConString = "Product_From_Part_" & prt & "/" & BodyName(i) & ".1/!" & "Product_From_Part_" & prt & "/" & BodyName(i) & ".1/"

  arrayOfVariantOfBSTR1(0) = Left(name, Len(name) - Len(partDocument1.name)) & BodyName(i) & ".CATPart"

Set products1Variant = products1

  StrConstrain = "Product_From_Part_" & Left(partDocument1.name, Len(partDocument1.name) - 8) & "/" & Left(partDocument1.name, Len(partDocument1.name) - 8) & "_PartBody.1/!" & "Product_From_Part_" & Left(partDocument1.name, Len(partDocument1.name) - 8) & "/" & Left(partDocument1.name, Len(partDocument1.name) - 8) & "_PartBody.1/"

  products1Variant.AddComponentsFromFiles arrayOfVariantOfBSTR1, "All"

Set reference1 = product1.CreateReferenceFromName(ConString)

Set constraint1 = constraints1.AddMonoEltCst(catCstTypeReference, reference1)

Next 'i

CATIA.StartCommand "Fit All In"

End Sub

 

[itsmyjob]

read my post again

Eric N.
indocti discant et ament meminisse periti ​

 

[LWolf]

you have a line that says
On Error Resume Next , this is to deal with type mismatch of your file (should be a part and not a product)
finish this by putting On Error goto 0:

On Error Resume Next
Set partDocument1 = CATIA.ActiveDocument
If Err.Description = "Type mismatch" Then

MsgBox "You must have a CATPart as active document"​

Exit Sub​

End If
on Error Goto 0

this will help you find any errors...



regards,
LWolf

 

[lardman363]

I agree with itsmyjob, you need to take a look at your bodies collection after you reassign the partbody.

Prior to pasting, if there is only one body in the part, just set that to a variable and delete it after you paste

Set oBodyToDelete = oPart.Bodies.Item(1)
'Paste
Catia.ActiveDocument.Selection.Add oBodyToDelete 
Catia.ActiveDocument.Selection.Delete

If there are multiple bodies in the part, you could run into other issues:
Note that in code, all bodies appear at the root of the part so if you have just the part body with several bodies nested inside using boolean operations, all of those bodies will appear at the root.

You can loop through the bodies collection and see if the bodies are at the root of the tree

For i=1 to oPart.Bodies.Count
[indent]set oBody = oPart.Bodies.Item(i)
If oBody.InBooleanOperation = False then
[indent]'Part is at the root of the tree[/indent]
End if[/indent]
Next

Once you know it is at the root of the tree...if you know it is empty you can check to see if it has shapes

If oBody.Shapes.Count = 0 then
[indent]Catia.ActiveDocument.Selection.Add oBody
Catia.ActiveDocument.Selection.Delete[/indent]
End if