Attribute VB_Name = "Create_PointOnCurve"
' Makro:        Create_PointOnCurve
' Version:      1.0
' Catia Level:  V5R19
' UIL:          English (User Interface Language)
' Autor:        Christian Obholzer
' E-Mail:       ch.obholzer@aon.at
' Erstellt:     01.12.2010
' Zweck:        Es wird ein Punkt auf einer Kurve erstellt; Abstand des Punktes mit Parameter verknüpft
'-----------------------------------------------------------------------------------
' Änderungen:   Datum, Name
'               Hier wird die Änderung angegeben
'               Datum, Name
'               Hier wird die Änderung angegeben
'-----------------------------------------------------------------------------------

Option Explicit
    
Sub CATMain()

    '***Deklarationen
    Dim objWindows As Windows
    Dim objDoc As Document
    Dim strTyp As String
    Dim objPart As Part
    Dim HBodies As HybridBodies
    Dim GeoSet As HybridBody
    Dim objParameters As Parameters
    Dim strParameter As StrParam
    Dim lgAbstand As Length
    Dim objPoint As HybridShapePointOnCurve
    Dim objSel As Object
    Dim strSel As String
    Dim strSearchFilter(0)
    Dim objRefPoint As Object
    Dim objRefCurve As Object
    Dim lgPoint_Abstand As Length
    Dim Wzk3D As HybridShapeFactory
    Dim relRelations As Relations
    Dim Formel As Formula

    '***Fehlerroutine einschalten
    On Error GoTo Fehler

    '***Abfrage nach geöffnetem Dokument
    Set objWindows = CATIA.Windows
    If objWindows.Count = 0 Then
        MsgBox "Es ist kein Dokument geöffnet." & vbNewLine & _
        "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Kein Dokument offen"
        Exit Sub
    End If

    '***Auslesen der Dokumentart
    Set objDoc = CATIA.ActiveDocument
    strTyp = TypeName(objDoc)
    If strTyp <> "PartDocument" Then
        MsgBox "Dieses Dokument ist kein Part." & vbNewLine & _
        "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Falscher Dokumententyp"
        Exit Sub
    End If
    
    Set objPart = objDoc.Part
    Set HBodies = CATIA.ActiveDocument.Part.HybridBodies
    Set objSel = objDoc.Selection
    '***Vorselektion löschen um das Ergebnis nicht zu verfälschen
    objSel.Clear
    
    '***Geometrisches Set auf erster Ebene erstellen
    Set GeoSet = HBodies.Add
    GeoSet.Name = "Point_on_Curve"
    
    '***Parameter erstellen
    Set objParameters = objPart.Parameters
    Set lgAbstand = objParameters.CreateDimension("Abstand", "Length", 123)
    
    '***Meldung an User
    MsgBox "Wählen Sie die Spline aus"
    
    '***Element selektieren
    strSearchFilter(0) = "HybridShapeSpline"
    strSel = objSel.SelectElement2(strSearchFilter, "Wählen Sie die Spline aus", False)
    '***Auswertung der Selektion
    If strSel = "Cancel" Then
        MsgBox "Abbruch der Selektion durch den User." & vbNewLine & _
        "Das Makro wird beendet.", vbExclamation + vbOKOnly, "Abbruch der Selektion"
        objSel.Clear
        Exit Sub
    End If
    '***Referenz erstellen
    Set objRefCurve = objPart.CreateReferenceFromObject(objSel.Item(1).Value)
    
    '***Meldung an User
    MsgBox "Wählen Sie den Startpunkt aus"
    
    '***Element selektieren
    strSearchFilter(0) = "Point"
    strSel = objSel.SelectElement2(strSearchFilter, "Wählen Sie den Startpunkt aus", False)
    '***Auswertung der Selektion
    If strSel = "Cancel" Then
        MsgBox "Abbruch der Selektion durch den User." & vbNewLine & _
        "Das Makro wird beendet.", vbExclamation + vbOKOnly, "Abbruch der Selektion"
        objSel.Clear
        Exit Sub
    End If
    '***Referenz erstellen
    Set objRefPoint = objPart.CreateReferenceFromObject(objSel.Item(1).Value)
    
    '***Punkt erstellen
    Set Wzk3D = objPart.HybridShapeFactory
    Set objPoint = Wzk3D.AddNewPointOnCurveWithReferenceFromDistance(objRefCurve, objRefPoint, lgAbstand.Value, True)
    objPoint.Name = "Point_on_Curve"
    '***Punkt in Geometrisches Set verschieben
    GeoSet.AppendHybridShape objPoint
    
    '***Part updaten
    objPart.Update
    
    '***Parameter vom Punkt ansprechen
    Set lgPoint_Abstand = objParameters.Item(objPart.Name & "\Point_on_Curve\Point_on_Curve\Length")
    
    '***Formel ersellen
    Set relRelations = objDoc.Part.Relations
    '***Formel zur Verknüpfung mit dem Parameter
    Set Formel = relRelations.CreateFormula("Abstand", "", lgPoint_Abstand, "Abstand")
    
    '***Part updaten
    objPart.Update

Exit Sub

'***Fehlerbehandlung: Ausgabe der Fehlernummer und Fehlerbeschreibung
Fehler:
    MsgBox "Fehlernummer: " & Err.Number & vbNewLine & _
    "Fehlerbeschreibung: " & Err.Description, vbCritical + vbOKOnly, "Fehler"
    
End Sub
