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:
I created a simple one but didn't figure it out how to work in product.
Here is my code:
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
Last edited: