'-------------------------------------------------------------------------------------------------------------------------------------------------
Sub CATMain()
'-------------------------------------------------------------------------------------------------------------------------------------------------

    ErzeugePart
    ErzeugeElemente
    WaehlePunkt

End Sub

'-------------------------------------------------------------------------------------------------------------------------------------------------
Sub ErzeugePart()
'-------------------------------------------------------------------------------------------------------------------------------------------------

    Set productdocument1 = CATIA.ActiveDocument
    Set product1 = productdocument1.Product
    Set products1 = product1.Products
     
    Set document1 = CATIA.Documents.Add("Part")
    document1.Activate
    Dim part1 As Part
    Set part1 = document1.Part
    part1.Update

'------------------------------------- Neues Part speichern und schließen ---------------------------------------------------
                    
    Dim SDoc
    SDoc = document1.SaveAs("C:\Temp\NeuesPart.CATPart")
    Dim CDoc
    CDoc = document1.Close

'------------------------------------- Neues Part in Product einfügen -------------------------------------------------------

    Dim arrayOfVariantOfBSTR1(0)
    arrayOfVariantOfBSTR1(0) = "C:\Temp\NeuesPart.CATPart"
    Set products1Variant = products1
    products1Variant.AddComponentsFromFiles arrayOfVariantOfBSTR1, "All"
    product1.Update

End Sub

'-------------------------------------------------------------------------------------------------------------------------------------------------
Sub ErzeugeElemente()
'-------------------------------------------------------------------------------------------------------------------------------------------------

    Dim documents1 As Documents
    Set documents1 = CATIA.Documents
    
    Dim partDocument1 As PartDocument
    On Error Resume Next
    Set partDocument1 = documents1.Item("NeuesPart.CATPart")
    Dim part1 As Part
    Set part1 = partDocument1.Part
    
    Dim hybridbodies1 As HybridBodies
    Set hybridbodies1 = part1.HybridBodies
    
    Dim hybridbody1 As HybridBody
    Set hybridbody1 = hybridbodies1.Add()
    part1.UpdateObject hybridbody1
    hybridbody1.name = "GeoSet1"
            
    part1.Update
      
    Dim hybridShapeFactory1 As HybridShapeFactory
    Set hybridShapeFactory1 = part1.HybridShapeFactory
    Dim hybridShapes1 As HybridShapes
    Set hybridShapes1 = hybridbody1.HybridShapes
    
    Dim hybridShapePointCoord1 As Point
    Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(100, 100, 100)
        
    Dim hybridShapePointCoord2 As Point
    Set hybridShapePointCoord2 = hybridShapeFactory1.AddNewPointCoord(200, 200, 200)
        
    Dim axisSystems1 As AxisSystems
    Set axisSystems1 = part1.AxisSystems
    Dim axisSystem1 As AxisSystem
    Set axisSystem1 = axisSystems1.Item("Absolute Axis System")

    Dim reference1 As Reference
    Set reference1 = part1.CreateReferenceFromObject(axisSystem1)
    hybridShapePointCoord1.RefAxisSystem = reference1
    hybridShapePointCoord2.RefAxisSystem = reference1

    hybridbody1.AppendHybridShape hybridShapePointCoord1
    hybridbody1.AppendHybridShape hybridShapePointCoord2
        
    part1.Update

End Sub

'-------------------------------------------------------------------------------------------------------------------------------------------------
Sub WaehlePunkt()
'-------------------------------------------------------------------------------------------------------------------------------------------------

    Dim documents1 As Documents
    Set documents1 = CATIA.Documents
    
    Dim partDocument1 As PartDocument
    On Error Resume Next
    Set partDocument1 = documents1.Item("NeuesPart.CATPart")
    Dim part1 As Part
    Set part1 = partDocument1.Part
    
    Dim hybridbodies1 As HybridBodies
    Set hybridbodies1 = part1.HybridBodies
    Dim hybridbody1 As HybridBody
    Set hybridbody1 = hybridbodies1.Item("GeoSet1")
    
    Dim parameters1 As Parameters
    Set parameters1 = part1.Parameters
    
    For n = 1 To hybridbody1.HybridShapes.Count
        Dim itemname
        itemname = hybridbody1.HybridShapes.Item(n).name
        Dim Punkt As Point
        Set Punkt = parameters1.Item(itemname)
        Dim reference2 As Reference
        Set reference2 = part1.CreateReferenceFromObject(Punkt)
    Next n

    part1.Update

End Sub