'------------------------------------------------------------
' original Makroname = KopyPARTtoPRODUCT.CATScript
' Makroname = PARTtoPRODUCT_R16_hybrid_4.CATScript
'
' Author:   Filippo Gozza
' Version:  V5R10, V5R12
'
' angepasst an V5R16    -   Lusilnie@cad.de
' Erweiterung GeoSets   -   Lusilnie@cad.de
' PartBody tauschen     -   Lusilnie@cad.de
' Korrekturen           -   denyo_1@cad.de
' Korrekturen           -   Lusilnie@cad.de
'------------------------------------------------------------
' Konvertiert ein CATPart in ein CATProduct
' Alle Koerper werden in CATPart's konvertiert
' Erweiterung: Alle GeoSets werden auch in CATPart's kopiert
'------------------------------------------------------------

Language = "VBSCRIPT"

Dim KomponenteNeu As Products
Dim KoerperName
Dim OpenKoerperName
Dim hybridBodies As document
Dim Koerper  As Object
Dim QuellFenster As Window
Dim Letztekoerper
Dim UserSel As selection


Sub CATMain()
    
    Dim Activdocu As document
    Set Activdocu = CATIA.ActiveDocument
    
    '---------------------------------------------------
    ' Neue Product
    '---------------------------------------------------
    Dim PosString As Long
    
    partName = CATIA.ActiveDocument.Name
    
    Dim docu As Documents
    Set docu = CATIA.Documents
    
    Dim productDocu As document
    Set productDocu = docu.Add("Product")
    
    Dim ProductNeu  As product
    Set ProductNeu = productDocu.product
    
    PosString = InStr(1, partName, ".CATPart")
    ProductNeu.PartNumber = Mid(partName, 1, PosString - 1)
    '------------------------------------------------------
    
    FensterNebeneinander
    
    Set QuellFenster = CATIA.Windows.Item(1)
    QuellFenster.Activate
    
    Dim partBodies As Bodies
    'Set Activdocu = CATIA.ActiveDocument
    Set partBodies = Activdocu.Part.Bodies
    
    Dim koerperAnzahl
    koerperAnzahl = partBodies.Count
    
    Dim UserSel As Object
    Dim PartNeu As product
    Dim workPart As PartDocument
    For I = 1 To koerperAnzahl
        
        Set Koerper = partBodies.Item(I)
        KoerperName = Koerper.Name
        
        If Right(KoerperName, 1) = "\" Then
            KoerperName = Left(KoerperName, Len(KoerperName) - 1)
        End If
        
        KoerperName = Replace(KoerperName, "\", "_")
        
        'Koerper kopieren
        Activdocu.selection.Clear
        Activdocu.selection.Add Koerper
        Activdocu.selection.Copy
        Activdocu.selection.Clear
        
        'Part erzeugen und Koerper einfuegen
        On Error Resume Next
        Set PartNeu = ProductNeu.Products.AddNewComponent("Part", CStr(KoerperName))
        If Err.Number <> 0 Then
            On Error GoTo 0
            l = ProductNeu.Products.Count
            Set PartNeu = ProductNeu.Products.Item(l)
            KoerperName = KoerperName & "." & I
            PartNeu.PartNumber = KoerperName
            ProductNeu.Products.Item(l).Name = KoerperName & ".1"
        Else
            On Error GoTo 0
        End If
        
        ' Fenster mit neue Product activieren
        ProductNeu.Parent.Activate
        
        ' Alle Parts suchen
        PartSuchen ProductNeu.Parent, UserSel
        
        'ProductNeu.parent.Selection.Clear
        'ProductNeu.parent.Selection.Add UserSel.Item(UserSel.Count).Value
        ProductNeu.Parent.selection.Clear
        ProductNeu.Parent.selection.Add ProductNeu.Products.Item(PartNeu).ReferenceProduct.Parent.Part
        ' Variante 1: Einfuegen "wie vorhanden"
        'ProductNeu.Parent.selection.Paste
        ' Variante 2: Einfuegen als "toter Solid"
        ProductNeu.Parent.selection.PasteSpecial "CATPrtResultWithOutLink"
        ProductNeu.Parent.selection.Clear
        
        'eingefuegten Koerper zum PartBody machen und Ex-PartBody loeschen
        Set workPart = ProductNeu.Products.Item(PartNeu).ReferenceProduct.Parent
        If workPart.Part.Bodies.Count > 1 Then
            workPart.Part.MainBody = workPart.Part.Bodies.Item(workPart.Part.Bodies.Count)
            ProductNeu.Parent.selection.Add workPart.Part.Bodies.Item(1)
            ProductNeu.Parent.selection.Delete
            ProductNeu.Parent.selection.Clear
        End If
        
    Next
    
    Dim hybridBodies As hybridBodies
    'Set Activdocu = CATIA.ActiveDocument
    Set hybridBodies = Activdocu.Part.hybridBodies
    
    koerperAnzahl = hybridBodies.Count
    
    For I = 1 To koerperAnzahl
        
        Set Koerper = hybridBodies.Item(I)
        KoerperName = Koerper.Name
        
        If Right(KoerperName, 1) = "\" Then
            KoerperName = Left(KoerperName, Len(KoerperName) - 1)
        End If
        
        KoerperName = Replace(KoerperName, "\", "_")
        
        'Koerper kopieren
        Activdocu.selection.Clear
        Activdocu.selection.Add Koerper
        Activdocu.selection.Copy
        Activdocu.selection.Clear
        
        'Part erzeugen und Koerper einfuegen
        Set PartNeu = ProductNeu.Products.AddNewComponent("Part", CStr(KoerperName))
        
        ' Fenster mit neue Product activieren
        ProductNeu.Parent.Activate
        
        ' Alle Parts suchen
        PartSuchen ProductNeu.Parent, UserSel
        
        'ProductNeu.parent.Selection.Clear
        'ProductNeu.parent.Selection.Add UserSel.Item(UserSel.Count).Value
        ProductNeu.Parent.selection.Clear
        ProductNeu.Parent.selection.Add ProductNeu.Products.Item(PartNeu).ReferenceProduct.Parent.Part
        ' Variante 1: Einfuegen "wie vorhanden"
        'ProductNeu.Parent.selection.Paste
        ' Variante 2: Einfuegen als "totes Element"
        ProductNeu.Parent.selection.PasteSpecial "CATPrtResultWithOutLink"
        ProductNeu.Parent.selection.Clear
        
    Next
    
    ' Product actualisieren
    ProductNeu.ApplyWorkMode DESIGN_MODE
    On Error Resume Next
    ProductNeu.Update
    If Err <> 0 Then
        MsgBox "Problem with update!" & vbLf & vbLf & "Please update manual!", vbCritical + vbOKOnly, "Update-Error"
    End If
    On Error GoTo 0
    
End Sub


Sub PartSuchen(oPartDoc1, UserSel)
    
    Dim E As Object 'CATBSTR
    Dim Was(0)
    Was(0) = "Part"
    
    'Dim UserSel As Object
    Set UserSel = oPartDoc1.selection
    UserSel.Clear
    
    'Let us first fill the CSO with all the objects of the model
    UserSel.Search ("CATPrtSearch.PartFeature,all")
    
    'E = UserSel.SelectElement2(Was, "Alle CATPart wählen", True)
    'Letztekoerper = UserSel.Count
    
End Sub


Sub FensterNebeneinander()
    
    Dim windows1 As Windows
    Set windows1 = CATIA.Windows
    
    windows1.Arrange catArrangeTiledVertical
    
End Sub