---

Hi,

ich bin gerade dabei ein Makro zu schreiben um eine Bohrpunktskizze
zu erstellen. Es soll eine Linie mit Punkten darauf sein. Per
Userform wird die Länger und Position der Linie abgefragt und die
Menge der Punkte.
Aktuell wird eine Linie als Konstruktionselement erzeugt mit zwei
Eckpunkten. Nun liegt das Problem darin die weiteren Punkte zu
erzeugen.

Mein Gedanke war es dies mit CATIA.StartCommand ("Equidistant Points")
zu realisieren, was auch soweit funktioniert. Die Frage ist nun
allerdings, wie übergebe ich die Linie um die es geht und die Menge
der Punkte und bestätige dann das Fenster mit OK?

Wenn das dann funktionieren sollte, soll das erste Maß der Punkte mit
der Länger der Linie verbunden werden (also Länge Linie / Anzahl
Punkte).

Ich hoffe dass jemand helfen kann 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Ich bezweifle dass das "schön" über Startcommands geht (ggf über SendKeys).
Du könntest auch über eine Schleife die Methode "AddNewPointOnCurveFromPercent" aufrufen und darin auch die Formel für die Lage des Punktes erstellen (falls das notwendig ist)

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ok vielen Dank.

Ich schau mal ob ich das irgendwie hinbekomme.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Also ich bekomme nichts funktionierendes hin oO

So ist mein aktueller Stand:

Code:

---

Private Sub CreateSketchLine(ByRef PointCount As Integer, ByRef LengthLine As String, ByRef oDirection As String)
' Variablen deklarieren
    Set oDoc = CATIA.ActiveDocument
    Set oPart = oDoc.Part
    Set HybBodies = oPart.HybridBodies

    On Error Resume Next
        Set HybBody = HybBodies.Item("Bohrpunkte")
    If Err.Number <> 0 Then
        Set HybBody = HybBodies.Add()
        HybBody.Name = "Bohrpunkte"
    End If

        Set oSketches = HybBody.HybridSketches

' Anzahl Punkte definieren
    Dim PointToCreate As Integer
    PointToCreate = PointCount - 2

' Koordinaten definieren
    If oDirection = "HDirection" Then
        X1 = "0"
        Y1 = "0"
        X2 = LengthLine
        Y2 = "0"
    End If
    If oDirection = "VDirection" Then
        X1 = "0"
        Y1 = "0"
        X2 = "0"
        Y2 = LengthLine
    End If

' Referenzfläche selektieren
    Set oSel = oDoc.Selection
    oSel.Clear
        ReDim sFilter(1)
        sFilter(0) = "Plane"
        sFilter(1) = "Face"
        Box = oSel.SelectElement2(sFilter, "", True)
            If (Box = "Cancel") Then
                Exit Sub
            End If

' Sketch auf der Referenz erzeugen
    If Box = "Normal" Then
        Set oRef = oSel.Item(1).Value
        Set oSketch = oSketches.Add(oRef)
    End If

    Dim arrayOfVariantOfDouble1(8)
        arrayOfVariantOfDouble1(0) = 0#
        arrayOfVariantOfDouble1(1) = 0#
        arrayOfVariantOfDouble1(2) = 0#
        arrayOfVariantOfDouble1(3) = 0#
        arrayOfVariantOfDouble1(4) = 0#
        arrayOfVariantOfDouble1(5) = 0#
        arrayOfVariantOfDouble1(6) = 0#
        arrayOfVariantOfDouble1(7) = 0#
        arrayOfVariantOfDouble1(8) = 0#

' Sketch und Editor öffnen
    oSketch.SetAbsoluteAxisData arrayOfVariantOfDouble1
    oPart.InWorkObject = oSketch
    Set factory2D1 = oSketch.OpenEdition()
    oPart.InWorkObject = oSketch

' Geometrien erzeugen
    Set geometricElements1 = oSketch.GeometricElements
        Set axis2D1 = geometricElements1.Item("AbsoluteAxis")

        ' Linie (Konstr.Elemente) mit zwei Eckpunkten erstellen
            Set point2D1 = factory2D1.CreatePoint(X1, Y1)
                point2D1.Construction = False
            Set point2D2 = factory2D1.CreatePoint(X2, Y2)
                point2D2.Construction = False
            Set line2D1 = factory2D1.CreateLine(X1, Y1, X2, Y2)
                line2D1.StartPoint = point2D1
                line2D1.EndPoint = point2D2
                line2D1.Construction = True

        ' Länger der Linie definieren
            Set constraints1 = oSketch.Constraints
                Set reference1 = oPart.CreateReferenceFromObject(line2D1)
                Set constraint1 = constraints1.AddMonoEltCst(catCstTypeLength, reference1)
                    constraint1.Mode = catCstModeDrivingDimension
                Set length1 = constraint1.Dimension
                    length1.Value = LengthLine

        ' Linie horizontal, vertikal oder nicht ausrichten
            Set geometricElements1 = oSketch.GeometricElements
            Set axis2D1 = geometricElements1.Item("AbsoluteAxis")
            Set line2D2 = axis2D1.GetItem(oDirection)
            Set reference1 = oPart.CreateReferenceFromObject(line2D1)
            Set reference2 = oPart.CreateReferenceFromObject(line2D2)

                If oDirection = "HDirection" Then
                    Set constraint1 = constraints1.AddBiEltCst(catCstTypeHorizontality, reference1, reference2)
                End If
                If oDirection = "VDirection" Then
                    Set constraint1 = constraints1.AddBiEltCst(catCstTypeVerticality, reference1, reference2)
                End If

        ' Symmetrische Zwischenpunkte erstellen falls nötig
            ' XXX
            ' XXX
            ' XXX
            ' XXX
            ' XXX
            ' XXX

' Sketch und Editor schließen
        oSketch.CloseEdition
        oPart.InWorkObject = oSketch
    oPart.Update
    On Error GoTo 0
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Wo scheiterst du an dem Script? Wie weit läuft dein Code?
Kleiner Tipp: Schmeiß mal das "On Error Resume Next" raus (dies bitte nur sehr bewusst uns sparsam einsetzen), dann sollten auch ein paar Fehlermeldungen kommen.

Gruß
Bernd

PS: arrayOfVariantOfDouble1 kann so nicht stimmen. Damit werden ja auch die Vertikal- und Horizontaltrichtung bestimmt. Somit müssen deren Komponenten einen Einheitsvektor bilden.

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

der Code läuft so wie er da steht komplett und ohne Probleme durch.

Nur bekomme ich eben die Zwischenpunkte nicht hin und habe einfach keine Idee...

Code:

---

        ' Symmetrische Zwischenpunkte erstellen falls nötig
            ' XXX
            ' XXX
            ' XXX
            ' XXX
            ' XXX
            ' XXX

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Wie wäre es mit die Zwischenpunkt einfach zu berechnen. zB (ungetestet)

Code:

---

for N = 1 to (PointToCreate )
    X3 = X1 + (X2-X1) * (N / PointToCreate )
    Y3 = Y1 + (Y2-Y1) * (N / PointToCreate )
    Set point2D3 = factory2D1.CreatePoint(X3, Y3)
    point2D3.Construction = False
    'ggf hier noch gleich die Bedingungen erzeugen
next

---

Gruß
Bernd

PS: Wundert mich das der Code läuft (Werte bei der Skizze machen für mich keinen Sinn, Werte werten als String an Methoden übergeben die zB Double erwarten)

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

vielen Dank.
Das probiere ich aus sobald ich dazu komme.

Also so hat es der Makrorekorder aufgezeichnet und wenn ich es rausnehme
hängt sich das Makro auf. So wie es jetzt ist läuft es mit und ohne
On Error Resume Next durch :-)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus,

also ich bin bisher nicht dazu gekommen und werde jetzt die nächsten
drei Monate wieder an der Uni sein.
Wird also etwas länger dauern bis ich mich wieder melde.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Bin doch noch dazu gekommen :-)

Läuft! Vielen Dank

Code:

---

    ' Anzahl Punkte definieren
        PointToCreate = PointCount - 2
        oDiv = PointCount - 1
        LengthDivide = LengthLine / oDiv

....

            ' Symmetrische Zwischenpunkte erstellen falls nötig
                If PointToCreate > 0 Then
                    For i = 1 To (PointToCreate)
                        X3 = X1 + (i * LengthDivide)
                        Y3 = Y1
                        ' Punkte Coincident auf der Linie
                            Set point2D3 = factory2D1.CreatePoint(X3, Y3)
                                point2D3.Construction = False
                            Set constraint2 = Constraints.AddBiEltCst(catCstTypeOn, point2D3, line2D1)
                                constraint2.Mode = catCstModeDrivingDimension
                        ' Length vom ersten Punkt zu dem jeweiligen weiteren Punkt erzeugen
                            Set reference3 = oPart.CreateReferenceFromObject(point2D1)
                            Set reference4 = oPart.CreateReferenceFromObject(point2D3)
                            Set constraint3 = Constraints.AddBiEltCst(catCstTypeDistance, reference3, reference4)
                                constraint3.Mode = catCstModeDrivingDimension
                            Set length3 = constraint3.Dimension
                        ' Name der length1 für die Formel ermitteln
                            Dim oPartName As Long
                            Dim lengthName As String
                                oPartName = Len(oPart.Name) + 1
                                lengthName = Right(length1.Name, (Len(length1.Name) - oPartName))
                        ' Formel erstellen und mit Length verknüpfen
                            Set Relations = oPart.Relations
                            Dim strFormula As String
                            strFormula = "(" & lengthName & "/" & oDiv & ")*" & i
                            Set Formula = Relations.CreateFormula("automatic_Const_" & i, "", length3, strFormula)
                                Formula.Hidden = True
                                length3.Hidden = True
                    Next
                End If

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP