Dim oActiveDocument As Document

Dim oTargetPart As Part

Dim oTargetProduct As Product

Dim iOType(0)

Dim oSelection As Selection

Dim QueryString As String

Dim Status As String

Set oActiveDocument = Catia.ActiveDocument

Set oSelection = oActiveDocument.Selection

   

'filtr pro selekci - je mozne vybrat jen Part

iOType(0) = "Part"



BodyName = InputBox("Zadejte nazev Body pro kopirovani", "Vstup", "")

   

'sestavime retezec pro vyhledavani - hledame podle nazvu pouze uvnitr vyberu

QueryString = "Name = '" & BodyName & "', sel"

   

'vlastni vyber Partu

Status = oSelection.SelectElement2(iOType, "Vyberte cilovy Part", false)

 

'vytvorime instanci ciloveho Partu a odpovidajiciho Produktu

Set oTargetPart = oSelection.Item(1).Value

Set oTargetProduct = oTargetPart.Parent





'funkce pro kopirovani

Explore oActiveDocument.Product



oTargetPart.Update()

Sub Explore(oProduct)

Set oProducts = oProduct.Products 

   

For Each oProduct In oProducts

   oSelection.Clear()

   'vybereme aktualne prochazeni Part

   oSelection.Add(oProduct)

   'a zkusime v nem najit vse, co se jmenuje "PartBody"

   oSelection.Search(QueryString)

   'pokud jsme neco nasli (a nehledame to v cilovem Partu), probehne vlastni kopirovani

   If oSelection.Count > 0 And Not oProduct Is oTargetProduct Then

      oSelection.Copy()

      oSelection.Clear()

      oSelection.Add(oTargetPart)

      oSelection.PasteSpecial("CATPrtResultWithOutLink")

      oSelection.Clear()

   End If



   If oProduct.Products.Count > 0 Then

      Explore oProduct

   End If

Next

End Sub