Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

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

Copy bodies from selected part bodies in product

Y

yamaCad

Mechanical
Jan 12, 2025
5
Hello all,

I'm trying a coding in vb.net

I select bodies - parts - and target part value from CATIA and adding into listview.

After that I'm planning selected bodies copying from parts and paste to target part.

But something is going wrong.

I tried search body names in selected parts. But not worked as well. Maybe cycle is better. Any idea?

I'm trying to make like this:

Here is my code:


Code: 
Imports INFITF
Imports MECMOD
Imports PARTITF
Imports ProductStructureTypeLib
Imports System.Runtime.InteropServices
Imports System.Windows.Forms.VisualStyles.VisualStyleElement

Public Class Form1

    Private bodyToCopy As Body = Nothing
    Private targetProduct As Product = Nothing

    Private Sub copyBodyBtn_Click(sender As Object, e As EventArgs) Handles copyBodyBtn.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 selection As Selection = productDoc.Selection
        Dim filter As Object() = {"Body"} ' Filter dizisini Object türüne dönüştür
        Dim status As String = selection.SelectElement3(filter, "Lütfen Body'leri seçin.", False, CATMultiSelectionMode.CATMultiSelTriggWhenUserValidatesSelection, False)

        If status <> "Normal" Then
            MessageBox.Show("Body seçimi iptal edildi.", "Bilgi", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Return
        End If

        bodyList.Clear()
        bodyList.View = View.Details
        bodyList.Columns.Add("Body Name", 200) ' "Body Name" sütunu oluştur

        For i As Integer = 1 To selection.Count
            Dim body As Body = TryCast(selection.Item(i).Value, Body)
            If body IsNot Nothing Then
                Dim listItem As New ListViewItem(body.Name)
                bodyList.Items.Add(listItem)
            End If
        Next
    End Sub

    Private Sub partSelectBtn_Click(sender As Object, e As EventArgs) Handles partSelectBtn.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 selection As Selection = productDoc.Selection
        Dim filter As Object() = {"Product"} ' Product için filtre
        Dim status As String = selection.SelectElement3(filter, "Lütfen Part'ları seçin.", False, CATMultiSelectionMode.CATMultiSelTriggWhenUserValidatesSelection, False)

        If status <> "Normal" Then
            MessageBox.Show("Part seçimi iptal edildi.", "Bilgi", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Return
        End If

        partsList.Clear()
        partsList.View = View.Details
        partsList.Columns.Add("Part Name", 200) ' "Part Name" sütunu oluştur

        For i As Integer = 1 To selection.Count
            Dim selectedProduct As Product = TryCast(selection.Item(i).Value, Product)
            If selectedProduct IsNot Nothing Then
                Dim listItem As New ListViewItem(selectedProduct.Name)
                partsList.Items.Add(listItem)
            End If
        Next
    End Sub

    Private Sub targetPart_Click(sender As Object, e As EventArgs) Handles targetPart.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 selection As Selection = productDoc.Selection
        Dim filter As Object() = {"Product"} ' Filtre "Product" için
        Dim status As String = selection.SelectElement2(filter, "Lütfen bir hedef Part seçin.", False)

        If status <> "Normal" Then
            MessageBox.Show("Part seçimi iptal edildi.", "Bilgi", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Return
        End If

        Dim selectedProduct As Product = TryCast(selection.Item(1).Value, Product)

        If selectedProduct IsNot Nothing Then

            targetList.Clear()
            targetList.View = View.Details
            targetList.Columns.Add("Target Part Name", 200) ' "Target Part Name" sütunu

            Dim listItem As New ListViewItem(selectedProduct.Name)
            targetList.Items.Add(listItem)

            targetProduct = selectedProduct ' Hedef Part'ı kaydet

            MessageBox.Show($"Hedef Part seçildi: {selectedProduct.Name}", "Bilgi", MessageBoxButtons.OK, MessageBoxIcon.Information)
        Else
            MessageBox.Show("Geçersiz seçim yapıldı.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End If
    End Sub

    
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.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

    ' Kullanıcıdan hedef Part ve kaynak Body seçimlerini doğrula
    Dim partAName As String = txtMainPart.Text.Trim()
    Dim bodyNames As String() = txtBody.Text.Trim().Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)

    If String.IsNullOrWhiteSpace(partAName) OrElse bodyNames.Length = 0 Then
        MessageBox.Show("Lütfen hedef Part ve Body'leri seçin.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
        Return
    End If

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

        If partA Is Nothing Then
            Throw New Exception("Hedef Part bulunamadı.")
        End If
    Catch ex As Exception
        MessageBox.Show("Hedef Part bulunamadı: " & ex.Message, "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
        Return
    End Try

    ' Assembly ortamını kontrol et
    Dim designEnv As String = CATIA.GetWorkbenchId()
    If designEnv <> "Assembly" Then
        CATIA.StartWorkbench("Assembly")
    End If

    ' Body'leri tek tek işleme
    Try
        For Each bodyName In bodyNames
            Dim bodyA As Body = Nothing

            ' Kaynak Body'yi bul
            For i As Integer = 1 To rootProduct.Products.Count
                Dim currentProduct As Product = rootProduct.Products.Item(i)
                Try
                    Dim partB As Part = CType(currentProduct.ReferenceProduct.Parent, PartDocument).Part
                    bodyA = partB.Bodies.Item(bodyName)
                    Exit For
                Catch
                    ' Hata oluşursa bir sonraki ürüne geç
                End Try
            Next

            If bodyA Is Nothing Then
                MessageBox.Show($"Body '{bodyName}' bulunamadı.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Warning)
                Continue For
            End If

            ' Kopyalama ve yapıştırma işlemleri
            selection.Clear()
            selection.Add(bodyA)
            selection.Copy()

            selection.Clear()
            selection.Add(partA)
            selection.PasteSpecial("CATPrtResult")
        Next

        partA.Update()
        MessageBox.Show("Tüm Body'ler başarıyla kopyalandı ve hedef Part'a yapıştırıldı.", "Başarılı", MessageBoxButtons.OK, MessageBoxIcon.Information)
    Catch ex As Exception
        MessageBox.Show("İşlem sırasında bir hata oluştu: " & ex.Message, "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    End Try
End Sub
End Class
 
Last edited:
Replies continue below

Recommended for you

Sort by date Sort by votes
I updated the paste code but still have problem I select 4 parts. lets call it a.1 a.2 a.3 a.4 and TargetPart they have same named bodies. Result is like this: all bodies come from a.3 but I want like this:

a.1 -- body_a body_b body_c
a.2 --body_a body_b body_c
a.3 --body_a body_b body_c
a.4 --body_a body_b body_c

TargetPart --> body_a body_b body_c body_a body_b body_c body_a body_b body_c body_a body_b body_c

But my code give me like this :(

a.3 --body_a body_b body_c
a.3 --body_a body_b body_c
a.3 --body_a body_b body_c
a.3 --body_a body_b body_c

TargetPart --> body_c body_c body_c body_c body_c body_c body_c body_c body_c body_c body_c body_c

here is my latest code:
Code: 
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'ı bulma
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
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
        Try
            targetPart = CType(currentProduct.ReferenceProduct.Parent, PartDocument).Part
        Catch ex As Exception
            MessageBox.Show($"Hedef Part '{targetPartName}' yüklenemedi. Detay: {ex.Message}", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return
        End Try
        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'leri kontrol etme
If partsList.Items.Count = 0 Then
    MessageBox.Show("Lütfen kaynak Part'ları seçin.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Return
End If

Dim sourcePartNames As List(Of String) = partsList.Items.Cast(Of ListViewItem).Select(Function(item) item.Text).ToList()

If bodyList.Items.Count = 0 Then
    MessageBox.Show("Lütfen kopyalanacak Body'leri seçin.", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
    Return
End If

Dim bodyNames As List(Of String) = bodyList.Items.Cast(Of ListViewItem).Select(Function(item) item.Text).ToList()

Try
    ' Seçilen kaynak Part'ları işle
    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
                Try
                    sourcePart = CType(currentProduct.ReferenceProduct.Parent, PartDocument).Part
                Catch ex As Exception
                    MessageBox.Show($"Kaynak Part '{partName}' yüklenemedi. Detay: {ex.Message}", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Warning)
                End Try
                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

        ' Seçilen Body'leri kopyala ve 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

            ' Kopyalama işlemi
            selection.Clear()
            selection.Add(sourceBody)
            Try
                selection.Copy()
            Catch ex As Exception
                MessageBox.Show($"Body '{bodyName}' kopyalanırken hata oluştu: {ex.Message}", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Continue For
            End Try

            ' Yapıştırma işlemi
            selection.Clear()
            selection.Add(targetPart)
            Try
                selection.PasteSpecial("CATPrtResult")
            Catch ex As Exception
                MessageBox.Show($"Body '{bodyName}' hedef Part'a yapıştırılırken hata oluştu: {ex.Message}", "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End Try
        Next
    Next

    ' Hedef Part'ı güncelle
    targetPart.Update()
    MessageBox.Show("Seçilen Body'ler başarıyla hedef Part'a yapıştırıldı.", "Başarılı", MessageBoxButtons.OK, MessageBoxIcon.Information)
Catch ex As Exception
    MessageBox.Show("İşlem sırasında bir hata oluştu: " & ex.Message, "Hata", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
 
Upvote 0 Downvote
You must log in or register to reply here.

Similar threads

Y
  • Question
About copy - paste special - copy with link in product 1
Replies
3
Views
2K
yamaCad
Y
jzecha
  • Locked
  • Question
Part 2 Product Macro That Moves Parts
Replies
5
Views
214
Little Cthulhu
Little Cthulhu
sri91
  • Locked
  • Question
identify part or product document
Replies
2
Views
171
sri91
sri91
FuatErt
  • Locked
  • Question
Catia Vba Part or Product link isolate
Replies
2
Views
308
Little Cthulhu
Little Cthulhu
LeoVyc
  • Locked
  • Question
Equal holes from part recognition
Replies
1
Views
197
Little Cthulhu
Little Cthulhu

Part and Inventory Search

Sponsor

Back
Top Bottom