Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations IDS on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

About copy - paste special - copy with link in product

yamaCad

Mechanical
Jan 12, 2025
1
Hello all,

I'm trying to create a macro which is copies body and paste special with link in a Part (part_b). Then we going to paste special with link into other Part (part_a).

Firstly the body is published.

lets call it body_a

Maybe you know. In product when you trying to record a macro It give like this. It's broken like this:

Code:
Language="VBSCRIPT"

Sub CATMain()

Set productDocument1 = CATIA.ActiveDocument

Set selection1 = productDocument1.Selection

selection1.Clear

Set documents1 = CATIA.Documents

Set partDocument1 = documents1.Item("part_b.CATPart")

Set part1 = partDocument1.Part

Set bodies1 = part1.Bodies

Set body1 = bodies1.Item("body_a")

selection1.Add body1

selection1.Copy

Set product1 = productDocument1.Product

Set products1 = product1.Products

Set product2 = products1.Item("part_b")

Set product2 = products1.Item("part_b")

Set product2 = products1.Item("part_b")

Set partDocument2 = documents1.Item("part_a.CATPart")

Set part2 = partDocument2.Part

part2.Update

Set product2 = products1.Item("part_b")

Set product2 = products1.Item("part_b")

End Sub


I created a simple one but didn't figure it out how to work in product.

Here is my code:

Code:
Sub CATMain()

    ' CATIA oturumunu al
    Dim CATIA
    Set CATIA = GetObject(, "CATIA.Application")
    
    ' Aktif dokümanı al
    Dim activeDoc
    Set activeDoc = CATIA.ActiveDocument

    ' Seçim nesnesi oluştur
    Dim objSel
    Set objSel = activeDoc.Selection

    objSel.Clear

    ' "part_b" adlı Product'ı ara
    objSel.Search "Name=part_b,all"

    ' Eğer part_b bulunduysa devam et
    If objSel.Count > 0 Then
        ' part_b'yi al
        Dim PartB_Product
        Set PartB_Product = objSel.Item(1).Value

        ' "body_a"yı part_b içindeki body'leriyle bul
        Dim PartB_Bodies
        Set PartB_Bodies = PartB_Product.ReferenceProduct.Parent.Part.Bodies

        On Error Resume Next
        Dim body_a
        Set body_a = PartB_Bodies.Item("body_a")
        On Error GoTo 0

        ' Eğer body_a bulunursa, kopyalama işlemi yap
        If Not body_a Is Nothing Then
            MsgBox "body_a bulundu, kopyalanabilir"
        Else
            MsgBox "body_a bulunamadı"
            Exit Sub
        End If
    Else
        MsgBox "The product 'part_b' was not found."
        Exit Sub
    End If

    ' part_a adlı Product'ı ara
    objSel.Clear
    objSel.Search "Name=part_a,all"

    ' Eğer part_a bulunduysa devam et
    If objSel.Count > 0 Then
        ' part_a'ya geçiş yap
        Dim PartA_Product
        Set PartA_Product = objSel.Item(1).Value

        ' part_a dokümanını al
        Dim PartA_Doc
        Set PartA_Doc = PartA_Product.ReferenceProduct.Parent

        ' part_a Part'ını al
        Dim PartA_Part
        Set PartA_Part = PartA_Doc.Part

        ' Seçim nesnesini oluştur
        Dim selection2
        Set selection2 = PartA_Doc.Selection
        selection2.Clear

        ' Yapıştırma işlemi
        PartA_Doc.Activate
        PartA_Part.InWorkObject = PartA_Part.MainBody

        ' PasteSpecial komutunu kullanarak kopyayı yapıştırma
        selection2.PasteSpecial "CATPrtResultWithLink"

        ' Güncelleme işlemi
        PartA_Part.Update
        MsgBox "body_a başarıyla part_a'ya aktarıldı!"
    Else
        MsgBox "The product 'part_a' was not found."
        Exit Sub
    End If

End Sub
 

Attachments

  • Snipaste_2025-01-12_12-27-57.jpg
    Snipaste_2025-01-12_12-27-57.jpg
    41.5 KB · Views: 5
Last edited:

Part and Inventory Search

Sponsor