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 1

yamaCad

Mechanical
Jan 12, 2025
3
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: 11
Last edited:
Replies continue below

Recommended for you

You should use the Section object of root ProductDocument, don't use Selection of PartDocument.
The parameter for "AsResultWithLink" is "CATPrtResult", not "CATPrtResultWithLink" , you can find this from Automation Help.
Here is my code, you can take a look

Code:
Public Sub CATMain()
    Dim part_a As Part, part_b As Part
    Dim body_a As Body
    
    Dim rootPrdDoc As ProductDocument
    Set rootPrdDoc = CATIA.ActiveDocument
    
    Dim sel As Selection
    Set sel = rootPrdDoc.Selection
    
    Dim rootPrd As Product
    Set rootPrd = rootPrdDoc.Product
    
    Set part_a = rootPrd.Products.Item(1).ReferenceProduct.Parent.Part
    Set part_b = rootPrd.Products.Item(2).ReferenceProduct.Parent.Part
    
    Set body_a = part_b.Bodies.Item("body_a")

    'If the Part is activated, the copy and paste will fail.
    Dim designEnv As String
    designEnv = CATIA.GetWorkbenchId
    If designEnv <> "Assembly" Then
        CATIA.StartWorkbench "Assembly"
    End If

    sel.Clear
    sel.Add body_a
    sel.Copy
    
    sel.Add part_a
    sel.PasteSpecial "CATPrtResult"
    
    part_a.Update
End Sub
 
You should use the Section object of root ProductDocument, don't use Selection of PartDocument.
The parameter for "AsResultWithLink" is "CATPrtResult", not "CATPrtResultWithLink" , you can find this from Automation Help.
Here is my code, you can take a look

Code:
Public Sub CATMain()
    Dim part_a As Part, part_b As Part
    Dim body_a As Body
   
    Dim rootPrdDoc As ProductDocument
    Set rootPrdDoc = CATIA.ActiveDocument
   
    Dim sel As Selection
    Set sel = rootPrdDoc.Selection
   
    Dim rootPrd As Product
    Set rootPrd = rootPrdDoc.Product
   
    Set part_a = rootPrd.Products.Item(1).ReferenceProduct.Parent.Part
    Set part_b = rootPrd.Products.Item(2).ReferenceProduct.Parent.Part
   
    Set body_a = part_b.Bodies.Item("body_a")

    'If the Part is activated, the copy and paste will fail.
    Dim designEnv As String
    designEnv = CATIA.GetWorkbenchId
    If designEnv <> "Assembly" Then
        CATIA.StartWorkbench "Assembly"
    End If

    sel.Clear
    sel.Add body_a
    sel.Copy
   
    sel.Add part_a
    sel.PasteSpecial "CATPrtResult"
   
    part_a.Update
End Sub
Thanks. I found the automation documentation. Thank you so much It looks cool :) I got notes from my mistake btw here is my version.


Code:
Sub CATMain()
    ' CATIA Uygulamasını Al
    Dim CATIAApp
    Set CATIAApp = CATIA

    ' Aktif Belgeyi Kontrol Et
    If CATIAApp.Documents.Count = 0 Then
        MsgBox "Bir ürün veya parça açık değil. Lütfen bir ürün veya parça açın."
        Exit Sub
    End If

    ' Aktif Belgeyi Al
    Dim activeDoc
    Set activeDoc = CATIAApp.ActiveDocument

    ' body_a'yı Kopyalamak için Seçim Nesnesi
    Dim objSelBody
    Set objSelBody = activeDoc.Selection
    
    objSelBody.Clear
    objSelBody.Search "Name=body_a,all"

    If objSelBody.Count > 0 Then
        objSelBody.Copy
        MsgBox "body_a başarıyla kopyalandı!"
    Else
        MsgBox "body_a bulunamadı!"
        Exit Sub
    End If

    ' part_a'yı Bulmak için Seçim Nesnesini Temizle ve Yeniden Kullan
    objSelBody.Clear
    objSelBody.Search "Name=part_a,all"

    If objSelBody.Count > 0 Then
        ' Yeni Pencerede Aç
        CATIA.StartCommand "Open in New Window"
        MsgBox "part_a yeni bir pencerede açıldı!"
    Else
        MsgBox "part_a bulunamadı!"
        Exit Sub
    End If

    ' Yeni Açılan Pencereyi Al
    Dim newDoc
    On Error Resume Next
    Set newDoc = CATIAApp.ActiveDocument
    On Error GoTo 0

    If newDoc Is Nothing Then
        MsgBox "Yeni pencere açılırken bir hata oluştu."
        Exit Sub
    End If

    ' Yapıştırma Öncesi Doğru Hedefi Ayarla
    Dim targetProduct
    Set targetProduct = newDoc.Product

    ' Hedef Body'yi Seç
    Dim objSelTarget
    Set objSelTarget = newDoc.Selection
    objSelTarget.Clear

    ' Hedef: "PartBody" veya Başka Bir Body
    objSelTarget.Search "Name=PartBody,all"

    If objSelTarget.Count > 0 Then
        objSelTarget.Add objSelTarget.Item(1).Value
        objSelTarget.Paste
        MsgBox "body_a başarıyla PartBody içerisine yapıştırıldı!"
    Else
        MsgBox "PartBody bulunamadı. Lütfen part_a içerisinde geçerli bir hedef olduğundan emin olun."
        Exit Sub
    End If

    ' Seçimleri Temizle
    objSelBody.Clear
    objSelTarget.Clear
End Sub
 
You should use the Section object of root ProductDocument, don't use Selection of PartDocument.
The parameter for "AsResultWithLink" is "CATPrtResult", not "CATPrtResultWithLink" , you can find this from Automation Help.
Here is my code, you can take a look

Code:
Public Sub CATMain()
    Dim part_a As Part, part_b As Part
    Dim body_a As Body
   
    Dim rootPrdDoc As ProductDocument
    Set rootPrdDoc = CATIA.ActiveDocument
   
    Dim sel As Selection
    Set sel = rootPrdDoc.Selection
   
    Dim rootPrd As Product
    Set rootPrd = rootPrdDoc.Product
   
    Set part_a = rootPrd.Products.Item(1).ReferenceProduct.Parent.Part
    Set part_b = rootPrd.Products.Item(2).ReferenceProduct.Parent.Part
   
    Set body_a = part_b.Bodies.Item("body_a")

    'If the Part is activated, the copy and paste will fail.
    Dim designEnv As String
    designEnv = CATIA.GetWorkbenchId
    If designEnv <> "Assembly" Then
        CATIA.StartWorkbench "Assembly"
    End If

    sel.Clear
    sel.Add body_a
    sel.Copy
   
    sel.Add part_a
    sel.PasteSpecial "CATPrtResult"
   
    part_a.Update
End Sub
Also I wanted something like this is this possible? I take body name information I have 5 parts with same name with same bodies. I want copy all of this bodies from selected parts. And copy into main part. I set up something like this I selecting the bodies in one part after that in next textbox I select the parts at third part I select the paste part location. I planned a cycle. But about code didn't figure it out. I will share tonight at least how can I manage this bodies
 

Part and Inventory Search

Sponsor