Catia V5 VBA code to copy product items into a new component

[hdwdlnd]

I am trying to figure out how to get the new component to paste into a particular area of the parent tree instead of always being pasted into the bottom. I have a script that copies pre-highlighted parts/products/components into a component that the script creates but it drops into the bottom of the tree. I would like for it to go in just above the first highlighted item being copied. Any ideas?

 

[HarunMusic]

I guess you need to work with tree reordering, i want also go in that project with tree reordering so any info are welcome.

 

[cilici]

Hello,

If your process allows copy/cut-paste in the tree then use Cut and re-insert them in the order you'd like. Otherwise, no, I am not aware of any method of inserting in a specific position.

@HarunMusic: go here and in the description there is link to download an app to reorder the specs tree.

Hope it helps,
Calin

 

[hdwdlnd]

Here is a snipit of a larger set of code that seems to do what I want but only if the tree contains CGR's:

For Each component In CATIA.ActiveDocument.Product.Products
If component.HasAMasterShapeRepresentation Then
Set newComp = component.Products.AddNewProduct(component.name & ".1")
newComp.AddMasterShapeRepresentation

Within this loop it checks for the CGR's, copies them into a component, and deletes the original. If I step through this loop it is actually putting the components inline with each loop.

 

[hdwdlnd]

I appreciate the help and suggestions. So I went ahead and followed Calin's suggestion with the cut and paste however I get a "Copy (1)" for the parts and products at the top level of the tree that are being copied. I am using the selection cut and paste method in the script so I don't know why it is making copies of the parts.

 

[HarunMusic]

Hi cillici, i m not interested in downloading app, i m interested how to do it , i wrote macros and i want to make this one too, any hits are welcome.

https://catiavbmacro.com/

 

[hdwdlnd]

I see my issue has to do with the infamous blue problem. Because my current code does not perform any commands similar to double clicking on a tree item in order to change focus to that item I am getting duplicated items. Is the send key method still the best option for simulating this mouse command?

 

[hdwdlnd]

So here is what I have so far. Interestingly, if you step through the code the first Sel2.Paste actually occurs later in the code than right after that paste command. It seems to be pasting during the middle of a For loop but depending on the break points it seems to vary...Still makes part/product copies which is not desired. Stepping through the code seems to follow the procedure used when copying and pasting with the keyboard/mouse. Top of the tree is active. Insert new component. Highlight desired parts and copy. Double-click new component. CtrlV. Parts are inserted without being copied.

Sub CATMain()

Dim SelCheck As Integer

SelCheck = CATIA.ActiveDocument.Selection.Count2

Dim HCheck As String

If SelCheck = 0 Then

    MsgBox ("Items to be copied must be highlighted first")
    Exit Sub
    
End If

If SelCheck <= 1 Then

    HCheck = MsgBox("Are child components highlighted?", vbYesNo)
    
    If HCheck = vbNo Then
    
        MsgBox ("Hightlight items to be moved and try again")
        
        Exit Sub
        
    End If
    
End If

Dim NewCompName As String

NewCompName = InputBox("New Component Name", "Enter the name for the new component", "New Component")

Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument

Dim product1 As Product
Set product1 = productDocument1.Product

Dim products1 As Products
Set products1 = product1.Products

Dim iProduct As Product
Dim pProduct As Product
Dim nProduct As Product

Set oSel = CATIA.ActiveDocument.Selection

Dim i As Integer
Dim FName As String

i = CATIA.ActiveDocument.Selection.Count2

Dim Sel As Selection
Set Sel = productDocument1.Selection

Dim PNumber As String
Dim IName As String

Dim n As Integer

Dim CutStart As Integer

NameCheck:

CutStart = 0

n = 0

For Each product1 In CATIA.ActiveDocument.Product.Products

    n = n + 1
    
    product1.ApplyWorkMode DESIGN_MODE
    
    If product1.PartNumber = NewCompName Then
    
        NewCompName = InputBox("New component name already used.  Choose a different Name", "New Component")
                 
        GoTo NameCheck
        
    End If
    
    If product1.Name = oSel.Item(i).Value.Name Then
    
        CutStart = n + 1 - i
        
    End If

Next

Dim product2 As Product
Set product2 = products1.AddNewProduct("")

product2.Name = NewCompName & ".1"
product2.PartNumber = NewCompName

Set pProduct = products1.Item(NewCompName & ".1")

For i = 1 To CATIA.ActiveDocument.Selection.Count2

    FName = oSel.Item(i).Value.Name
    PNumber = oSel.Item(i).Value.PartNumber
    Set iProduct = products1.Item(FName)
    Sel.Add iProduct

Next

Sel.Cut

Dim Sel2 As Selection
Set Sel2 = CATIA.ActiveDocument.Selection
Sel2.Clear

Sel2.Add pProduct

AppActivate ("CATIA V5")
CATIA.StartCommand "FrmActivate"

Sel2.Paste

Sel2.Clear

Sel.Clear

n = n - i + 1

For i = CutStart To n

    FName = products1.Item(i).Name
    Set iProduct = products1.Item(FName)
    Sel.Add iProduct
    
Next

Set iProduct = productDocument1.Product
Sel.Cut

Sel2.Add iProduct

Sel2.Paste

Sel2.Clear

End Sub

 

[hdwdlnd]

So it appears it is how it is handling the cutting and pasting of components. If my tree only contains products and parts at the top level of the tree the script works fine. I started down the path of filtering them with a separate paste operation but was wondering if there is a better way to handle the paste operation than this.

Sub CATMain()

Dim SelCheck As Integer

SelCheck = CATIA.ActiveDocument.Selection.Count2

Dim HCheck As String

If SelCheck = 0 Then

    MsgBox ("Items to be copied must be highlighted first")
    Exit Sub
    
End If

If SelCheck <= 1 Then

    HCheck = MsgBox("Are child components highlighted?", vbYesNo)
    
    If HCheck = vbNo Then
    
        MsgBox ("Hightlight items to be moved and try again")
     
        Exit Sub
     
    End If
    
End If

Dim NewCompName As String

NewCompName = InputBox("New Component Name", "Enter the name for the new component", "New Component")

Dim productDocument1 As ProductDocument
Set productDocument1 = CATIA.ActiveDocument

Dim product1 As Product
Set product1 = productDocument1.Product

Dim products1 As Products
Set products1 = product1.Products

Dim iProduct As Product
Dim pProduct As Product

Set oSel = CATIA.ActiveDocument.Selection

Dim i As Integer
Dim FName As String

i = CATIA.ActiveDocument.Selection.Count2

Dim Sel As Selection
Set Sel = productDocument1.Selection

Dim n As Integer

Dim CutStart As Integer

NameCheck:

CutStart = 0

n = 0

Set IsComponent = Nothing

For Each product1 In CATIA.ActiveDocument.Product.Products

    n = n + 1
    
    product1.ApplyWorkMode DESIGN_MODE
    
    If product1.PartNumber = NewCompName Then
    
        NewCompName = InputBox("New component name already used.  Choose a different Name", "New Component")
                 
        GoTo NameCheck
     
    End If
    
    If product1.Name = oSel.Item(i).Value.Name Then
    
        On Error Resume Next
        
        IsComponent = oSel.Item(i).Value.FullName
        
        If Not IsComponent Is Nothing Then
        
            IsComponent = False
            
        Else
        
            IsComponent = True
            
        End If
        
        
    
        CutStart = n + 1 - i
     
    End If

Next

Dim product2 As Product
Set product2 = products1.AddNewProduct("")

product2.Name = NewCompName & ".1"
product2.PartNumber = NewCompName

Set pProduct = products1.Item(NewCompName & ".1")

For i = 1 To CATIA.ActiveDocument.Selection.Count2

    FName = oSel.Item(i).Value.Name
    PNumber = oSel.Item(i).Value.PartNumber
    Set iProduct = products1.Item(FName)
    Sel.Add iProduct

Next

Sel.Cut

Dim Sel2 As Selection
Set Sel2 = CATIA.ActiveDocument.Selection
Sel2.Clear

Sel2.Add pProduct

AppActivate ("CATIA V5")
CATIAApp.StartCommand "FrmActivate"

Sel2.PasteSpecial "CATProdCont"

Sel2.Clear

Sel.Clear

n = n - i + 1

For i = CutStart To n

    FName = products1.Item(i).Name
    Set iProduct = products1.Item(FName)
    Sel.Add iProduct
    
Next

Set iProduct = productDocument1.Product
Sel.Cut

Sel2.Add iProduct

Sel2.Paste 'Special "CATProdCont"

Sel2.Clear

End Sub