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
Here is my example data drive_link
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
'''