×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Separate Bodies different Catparts

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

RE: Separate Bodies different Catparts

i believe this is the same code. use catscrip to paste this code into

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 Sub 

RE: Separate Bodies different Catparts

(OP)
Ok,so the previous problem was just that I forgot to set the right Language.


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

no matter how i name my bodies this script works well for me. post a screen shot with an error

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources