---

hi folks,
ich muss leider nochmal nachfragen...
Stefan hat mich ja schon auf die richtige Fährte für die Umrechnung der Koordinaten gebracht, so dass ich nun für die gesamte Skizze der Bohrpunkte eine Koordinatentransformation auf Modellkoordinaten hinbekomme.
Nun zeigt sich aber, dass die Punkte auf einer Skizze nicht nur die Bohrpositionen zeigen, sonderen auch noch andere Skizzenpunkte auflisten.
Nun habe ich mir so in meinem jugendlichen Leichtsinn gedacht, dass man dann anstelle der Skizzen vPtArr doch einfach das "HoleFeatureData.GetSketchPoints" umrechnen lässt. Aber dabei kriege ich die Objekte bzw Rückgaben nicht richtig zugeordnet, da das Ergebnis nach der Funktion nicht mehr stimmig ist.

Kann mir da bitte einer mal über die Klippe helfen?
Vielen Dank schon mal an dieser Stelle...

    Public Sub BohrfeatureAuswerten(ByVal FeatureName As String, ByVal SkizzeName As String)

        Dim swApp As SldWorks.SldWorks
        Dim swModel As SldWorks.ModelDoc2
        Dim swMathUtil As SldWorks.MathUtility
        Dim swSelMgr As SldWorks.SelectionMgr
        Dim swFeature As SldWorks.Feature
        Dim swFeatureSkizze As SldWorks.Feature
        Dim swSkizze As SldWorks.Sketch
        Dim swSkizzeXform As SldWorks.MathTransform
        Dim pt As SldWorks.SketchPoint
        Dim swPt As SldWorks.MathPoint
        Dim vSketchPt As Object
        Dim nSketchPtData(2) As Double
        Dim vSketchPtData As Object
        Dim swSketchPt As SldWorks.SketchPoint
        Dim swEnt As SldWorks.Entity
        Dim nEntType As Long
        Dim vNormal As Object

        Dim HoleFeatureData As SldWorks.IWizardHoleFeatureData2
        Dim AnzBohrungen As Long
        Dim xValue As Double
        Dim yValue As Double
        Dim zValue As Double

        FeatureName = "Ø4.0 (4) Durchmesser Bohrung1"
        SkizzeName = "Skizze7"

        swApp = CreateObject("SldWorks.Application")
        swMathUtil = swApp.GetMathUtility
        swModel = swApp.ActiveDoc

        'aktiviere das gewünschte Feature
        swFeature = swModel.FeatureByName(FeatureName)
        Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "Bohrfeature auswerten")

        'erste Skizze des Features wählen (Punkteebene)
        swFeatureSkizze = swModel.FeatureByName(SkizzeName)
        swModel.SelectByID(SkizzeName, "SKETCH", 0, 0, 0)
        swModel.InsertSketch()
        swSkizze = swModel.GetActiveSketch2

        'Auswertung des Bohrfeatures
        HoleFeatureData = swFeature.GetDefinition
        AnzBohrungen = HoleFeatureData.GetSketchPointCount

        BohrfeatureParameter(11) = swZahl(HoleFeatureData.CounterBoreDiameter, 4)
        BohrfeatureParameter(12) = swZahl(HoleFeatureData.CounterBoreDepth, 4)
        'usw.......

        'Bohrpositionen auslesen
        vPtArr = HoleFeatureData.GetSketchPoints

        For Each pt In vPtArr
            swSketchPoint = pt
            xValue = swSketchPoint.X  'Koordinaten übernehmen
            yValue = swSketchPoint.Y
            zValue = swSketchPoint.Z

            xValue = swZahl(xValue, 6)
            yValue = swZahl(yValue, 6)
            zValue = swZahl(zValue, 6)
            Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "          X = " & Str(xValue) & " / Y = " & Str(yValue) & " / Z = " & Str(zValue))
        Next

        'hier sollen die Punkte umgerechnet werden...
        vPtArr = GetModelCoordinates(swApp, swSkizze, vPtArr)

        For Each pt In vPtArr
            swSketchPoint = pt
            xValue = swSketchPoint.X  'Koordinaten übernehmen
            yValue = swSketchPoint.Y
            zValue = swSketchPoint.Z

            xValue = swZahl(xValue, 6)
            yValue = swZahl(yValue, 6)
            zValue = swZahl(zValue, 6)
            Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "          X = " & Str(xValue) & " / Y = " & Str(yValue) & " / Z = " & Str(zValue))
        Next
        Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "          X = " & Str(xValue) & " / Y = " & Str(yValue) & " / Z = " & Str(zValue))

        'Skizze wieder zumachen
        swModel.InsertSketch()

    End Sub

    Public Function GetModelCoordinates(ByVal swApp As SldWorks.SldWorks, ByVal swSketch As SldWorks.Sketch, ByVal vPtArr As Object) As Object

        On Error GoTo Fehler

        Dim swMathPt As SldWorks.MathPoint
        Dim swMathUtil As SldWorks.MathUtility
        Dim swMathTrans As SldWorks.MathTransform

        swMathUtil = swApp.GetMathUtility
        swMathPt = swMathUtil.CreatePoint(vPtArr)

        ' Is a unit transform if 3D sketch; for example, selected sketch
        ' point is automatically in model space

        swMathTrans = swSketch.ModelToSketchTransform
        swMathTrans = swMathTrans.Inverse
        swMathPt = swMathPt.MultiplyTransform(swMathTrans)

        GetModelCoordinates = swMathPt.ArrayData

        Exit Function
Fehler:
        MsgBox("Fehler bei der Koordinatenumrechnung!", MsgBoxStyle.Critical)
    End Function

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

---

Hallo apple,

ohne das jetzt probieren zu können fallen mir zwei Sachen auf: du übergibst deiner Function GetModelCoordinates das vPtArr (das Array, dass du über HoleFeatureData.GetSketchPointsermittelt hast) als Object und gibst als Funktionwert auch Object zurück. Das vPtArr deklarierst du gar nicht.

Zunächst solltest du also das vPtArr als Variant deklarieren (das wird implizit wohl gemacht, deswegen klappt der Code wohl bis dahin). Dann stellt sich mir die Frage, warum du das ganze Array an deine Funktion übergibst, die sieht eigentlich so aus, als sollte sie von einem einzelnen Sketchpoint die Modellkoordinaten ausrechnen und als Mathpoint zurückgeben. Also würde ich zunächst mal die Parameter anders übergeben

Public Function GetModelCoordinates(ByVal swApp As SldWorks.SldWorks, ByVal swSketch As SldWorks.Sketch, ByVal myPt As SldWorks.Sketchpoint) As SldWorks.MathPoint

und nicht das ganze Array übergeben, sondern für die einzelnen Sketchpunkte, die du ja in der For each pt in vPtArr - Schleife abfragst, die Transformation ermitteln, so ungefähr

        'hier sollen die Punkte umgerechnet werden...
        For Each pt In vPtArr
            swSketchPoint = GetModelCoordinates(swApp, swSkizze, pt)

Hab das alles nicht wirklich probiert sondern so aus dem hohlen Bauch raus geschrieben, vielleicht schaust du mal in die Richtung, ob das hilft.

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de
Stefans SolidWorks Blog

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

---

hallo Stefan,
vielen Dank für Deine Antwort.
Ich habe den gordischen Konten zerschlagen können.
Und hier für alle Anderen, die in das gleiche Problem laufen...
so long
apple

    Public Sub BohrfeatureAuswerten(ByVal FeatureName As String, ByVal SkizzeName As String)

        Dim swApp As SldWorks.SldWorks
        Dim swModel As SldWorks.ModelDoc2
        Dim swMathUtil As SldWorks.MathUtility
        Dim swFeature As SldWorks.Feature
        Dim swFeatureSkizze As SldWorks.Feature
        Dim swSkizze As SldWorks.Sketch
        Dim swSkizzeXform As SldWorks.MathTransform
        Dim swPunkt As SldWorks.MathPoint
        Dim swEnt As SldWorks.Entity
        Dim nEntType As Long
        Dim pt As SldWorks.SketchPoint
        Dim objPunkteArray As Object
        Dim objSkizzePunktDaten As Object
        Dim xyzSkizzePunktDaten(2) As Double
        Dim objNormal As Object
        Dim HoleFeatureData As SldWorks.IWizardHoleFeatureData2
        Dim AnzBohrungen As Long
        Dim xValue As Double
        Dim yValue As Double
        Dim zValue As Double

        swApp = CreateObject("SldWorks.Application")
        swMathUtil = swApp.GetMathUtility
        swModel = swApp.ActiveDoc

        'aktiviere das gewünschte Feature
        swFeature = swModel.FeatureByName(FeatureName)

        'Falls das Feature unterdrückt sein sollte, dann alles überstpringen
        If swFeature.IIsSuppressed2(1, 1, FeatureName) = True Then
            'MsgBox("Das Feature ist unterdrückt")
            Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "Das Feature '" & FeatureName & "' ist unterdrückt")
            Exit Sub
        End If

        Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "Bohrfeature auswerten")
       
        'erste Skizze des Features wählen (Punkteebene)
        swFeatureSkizze = swModel.FeatureByName(SkizzeName)
        swSkizze = swFeatureSkizze.GetSpecificFeature2

        'Erstellungsebene finden
        swEnt = swSkizze.GetReferenceEntity(nEntType)
        'Richtung der Bohrung normal zur Skizze
        objNormal = swEnt.Normal
        Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "    Vektor:  X = " & Str(objNormal(0)) & " / Y = " & Str(objNormal(1)) & " / Z = " & Str(objNormal(2)))

        swSkizzeXform = swSkizze.ModelToSketchTransform
        swSkizzeXform = swSkizzeXform.Inverse

        'Bohrpositionen auslesen

        'Auswertung des Bohrfeatures
        HoleFeatureData = swFeature.GetDefinition
        AnzBohrungen = HoleFeatureData.GetSketchPointCount
        objPunkteArray = HoleFeatureData.GetSketchPoints

        For Each pt In objPunkteArray
            swSketchPoint = pt

            'Koordinaten übernehmen
            xyzSkizzePunktDaten(0) = swSketchPoint.X
            xyzSkizzePunktDaten(1) = swSketchPoint.Y
            xyzSkizzePunktDaten(2) = swSketchPoint.Z
            objSkizzePunktDaten = xyzSkizzePunktDaten

            GoTo NoDebug
            xValue = swZahl(xyzSkizzePunktDaten(0), 6)
            yValue = swZahl(xyzSkizzePunktDaten(1), 6)
            zValue = swZahl(xyzSkizzePunktDaten(2), 6)
            Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "    Skizze  X = " & Str(xValue) & " / Y = " & Str(yValue) & " / Z = " & Str(zValue))
NoDebug:
            'Transformation von Skizze nach Modell
            swPunkt = swMathUtil.CreatePoint(objSkizzePunktDaten)
            swPunkt = swPunkt.MultiplyTransform(swSkizzeXform)

            xValue = swZahl(swPunkt.ArrayData(0), 6)
            yValue = swZahl(swPunkt.ArrayData(1), 6)
            zValue = swZahl(swPunkt.ArrayData(2), 6)
            Call Ausgabe(frmHauptfenster, frmHauptfenster.txtAusgabe, "    Modell  X = " & Str(xValue) & " / Y = " & Str(yValue) & " / Z = " & Str(zValue))

        Next
end sub

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