Paste as part body macro
Paste as part body macro
(OP)
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?
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?





RE: Paste as part body macro
indocti discant et ament meminisse periti
RE: Paste as part body macro
regards,
LWolf
RE: Paste as part body macro
CODE -->
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.Updatenow I would like delete first (empty) body, but simply adding to selection and delete doesn't work in this case...
CODE -->
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.ClearRE: Paste as part body macro
that would explain why nothing happens in your case as you can not delete main body.
If I am correct simply change to
CODE --> code
[...] sel.Add part2.Bodies.Item(2) sel.Delete [...]indocti discant et ament meminisse periti
RE: Paste as part body macro
CODE -->
sel.Add part2.Bodies.Item("Body.1") sel.Delete sel.ClearRE: Paste as part body macro
CODE -->
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 SubRE: Paste as part body macro
indocti discant et ament meminisse periti
RE: Paste as part body macro
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
on Error Goto 0
this will help you find any errors...
regards,
LWolf
RE: Paste as part body macro
Prior to pasting, if there is only one body in the part, just set that to a variable and delete it after you paste
CODE --> vba
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
CODE --> vba
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
CODE --> vba