Separate Bodies different Catparts
Separate Bodies different Catparts
(OP)
Sorry if this problem has already been solved by FERDO, but I cannot repea what he's done.
I admit I've never used a macro, and therefore I don't know where I'm making mikstakes
That's the script
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
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.Update
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
End Sub
But when I run it, an error message pops out telling something like this (I translate from Itian)
Origin:MicrosoftVBScrip compilation error
Description:End of instruction expected
Instruction:Dim i, n As Integer
Line 9
Column 9
So, what is wrong?
Thank you very much
I admit I've never used a macro, and therefore I don't know where I'm making mikstakes
That's the script
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
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.Update
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
End Sub
But when I run it, an error message pops out telling something like this (I translate from Itian)
Origin:MicrosoftVBScrip compilation error
Description:End of instruction expected
Instruction:Dim i, n As Integer
Line 9
Column 9
So, what is wrong?
Thank you very much





RE: Separate Bodies different Catparts
CODE --> catscript
Language="VBSCRIPT" 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 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.Update 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 End SubRE: Separate Bodies different Catparts
Now I've discovered a little problem, that anyway is wquite an issue for me.
This script works only if the body name is "body.x" where x is a number. Is it possible to change it so that it works regardless of the body name?
RE: Separate Bodies different Catparts