Catia copy selected bodies from part to part in product level
10:19 01 Nov 2025

I'm trying to copy bodies from selected parts to a target part, but there is a unique problem when copying and pasting bodies at product level. I also managed constraints with multiple axes, but copying bodies does not work properly.

My target to create a macro like this in vb.net

macro_example

Here is my example data drive_link

picture

I have 3 lists in my code. First one takes body names. Second one takes part names. Third one selects the target part I select my body names, parts, and target part to paste. It works perfectly on different parts But when I use the same body name with different instance names, it only takes from the same part with 4 bodies.

'''

Private Sub StartPaste_Click(sender As Object, e As EventArgs) Handles StartPaste.Click
Dim CATIA As Application
Try
    CATIA = CType(Marshal.GetActiveObject("CATIA.Application"), Application)
Catch ex As Exception
    MessageBox.Show("CATIA çalışmıyor. Lütfen başlatın.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Return
End Try

Dim productDoc As ProductDocument
Try
    productDoc = CType(CATIA.ActiveDocument, ProductDocument)
Catch ex As Exception
    MessageBox.Show("Lütfen bir ProductDocument açın.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Return
End Try

Dim rootProduct As Product = productDoc.Product
Dim selection As Selection = productDoc.Selection

' Hedef Part kontrolü
If targetList.Items.Count = 0 Then
    MessageBox.Show("Lütfen hedef Part'ı seçin.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Return
End If
Dim targetPartName As String = targetList.Items(0).Text

' Hedef Part'ı bul
Dim targetPart As Part = Nothing
For i As Integer = 1 To rootProduct.Products.Count
    Dim currentProduct As Product = rootProduct.Products.Item(i)
    If currentProduct.Name = targetPartName Then
        targetPart = CType(currentProduct.ReferenceProduct.Parent, PartDocument).Part
        Exit For
    End If
Next

If targetPart Is Nothing Then
    MessageBox.Show("Hedef Part bulunamadı.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Return
End If

' Kaynak Part ve Body'lerin kontrolü
If partsList.Items.Count = 0 Then
    MessageBox.Show("Lütfen kaynak Part'ları seçin.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Return
End If
If bodiesList.Items.Count = 0 Then
    MessageBox.Show("Lütfen Body'leri seçin.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Return
End If

' Kaynak Part isimleri ve Body isimleri
Dim sourcePartNames As List(Of String) = partsList.Items.Cast(Of ListViewItem).Select(Function(item) item.Text).ToList()
Dim bodyNames As List(Of String) = bodiesList.Items.Cast(Of ListViewItem).Select(Function(item) item.Text).ToList()

Try
    ' Seçilen tüm kaynak Part'lar için döngü
    For Each partName In sourcePartNames
        Dim sourcePart As Part = Nothing

        ' Kaynak Part'ı bul
        For i As Integer = 1 To rootProduct.Products.Count
            Dim currentProduct As Product = rootProduct.Products.Item(i)
            If currentProduct.Name = partName Then
                sourcePart = CType(currentProduct.ReferenceProduct.Parent, PartDocument).Part
                Exit For
            End If
        Next

        If sourcePart Is Nothing Then
            MessageBox.Show($"Kaynak Part '{partName}' bulunamadı.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Warning)
            Continue For
        End If

        ' Kaynak Part içindeki Body'leri bul ve hedef Part'a sırayla link olarak yapıştır
        For Each bodyName In bodyNames
            Dim sourceBody As Body = Nothing
            Try
                sourceBody = sourcePart.Bodies.Item(bodyName)
            Catch ex As Exception
                MessageBox.Show($"Body '{bodyName}' kaynak Part '{partName}' içinde bulunamadı.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Warning)
                Continue For
            End Try

            ' Body'yi seç ve link olarak kopyala
            selection.Clear()
            selection.Add(sourceBody)
            selection.Copy()

            ' Hedef Part içinde link olarak yapıştır
            selection.Clear()
            targetPart.InWorkObject = targetPart.MainBody
            selection.Add(targetPart.MainBody)
            selection.PasteSpecial("CATPrtResult")

            'txtStatus.AppendText($"Body '{bodyName}' başarıyla '{targetPartName}' içine link olarak yapıştırıldı." & vbNewLine)
        Next
    Next
    targetPart.Update()
    'MessageBox.Show("Tüm body'ler başarıyla hedef part'a link olarak yapıştırıldı.", "Bilgi", MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch ex As Exception
    MessageBox.Show("Bir hata oluştu: " & ex.Message, "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub

'''

vb.net catia