---

Guten Morgen, ich habe div. Blechbauteile (IPT)! diese IPT‘s mit Stanzbilder hätte ich gerne automatisch bemaßt. Ist Es möglich, dass auch schon in der IPT über eine Regel zu erstellen, oder muss ich eine DWG anlegen, und dort eine Regel schreiben?

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

---

Moin

Du kannst auch bereits in der IPT Skizzenbemaßungen oder 3D-Modellanmerkungen an das Stanzbild setzen. Das kommt darauf an, wie die zu bemaßende Geometrie erzeugt wird. Wenn eine Reihe Löcher erst durch eine Reihenanordnung erzeugt wird, kann man in der Skizze logischerweise den Lochabstand noch nicht bemaßen. Eine Mischung aus beiden ist auch möglich.
Die Bemaßungen können in der Ansicht auf der Zeichnung abgerufen und eingeblendet werden. Meist fliegen die Bemaßungen dann irgendwo hin und das Positionieren per Code ist nicht ganz einfach.
Generell, wenn die zu bemaßenden Objekte nicht bereits irgendwie gekennzeichnet sind, ist es per Code wirklich eine Herausforderung eine funktionale und sinnvolle Bemaßung zu erstellen. Einfach die Länge oder den Radius jeder Kante zu bemaßen ist meist unzureichend.

------------------
MfG
Ralf

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

---

Die Stanzbilder werden mit einer Regel platziert, ich bräuchte auch nur die Mittelpunkt Bemaßung!

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

---

Und diese 3D Anmerkungen in IPT-INVENTOR funktioniert auch mit ilogic?

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

---

Moin

Die Stanzbildermittelpunkte bekommt man im Modell über die PunchToolFeature.CenterPoints als Skizzenpunktkollektion. Für die 3D-Anmerkungen wirst du die mit einem SketchToModelTransform in den Modellraum übertragen müssen. Dann musst du dir noch überlegen, was du als Nullpunkt nimmst. Koordinatenursprung wäre hier das einfachste. Vom Ursprung und dem Skizzenpunkt jeweils ein GeometryIntent erstellen, die Blechfläche als AnnotationPlane definieren und dann noch einen Punkt für die TextPosition ermitteln. Dann hast du alle Infos zusammen, glaub ich.

Seit Version 2018 sollte es funktionieren bzw. alles was die API bietet ist auch über iLogic erreichbar.

------------------
MfG
Ralf

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

---

Vielen Dank für diesen Info, wie würde das Code-technisch aussehen? Oder besser gefragt kannst du mich dabei unterstützen?

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

---

Screenshot_Modellbemassung.jpg

Moin

Anbei ein stark vereinfachtes Beispiel. Erzeuge ein Blechteil mit einer Fläche auf der XY-Ebene und die linke untere Ecke sollte im Ursprung liegen. Dann einfach ein paar Stanzungen einfügen und mal laufen lassen. Die Positionierung der Maße ist durcheinander weil einfach die Punkte wie sie kommen benutzt werden. Da müßte man die Kollektionen erst aufsteigend nach X bzw. Y sortieren und auch der Abstand zum Modell sollte einer sinnvollen Regel folgen.
Mit der CreateAnnotationPlaneDefinitionUsingPlane Methode müßte es auch gehen die Plane der Skizze des Stanzfeatures zu nehmen. Immer davon auszugehen, das die Fläche auf XY liegt dürfte nicht funktionieren. Ebenso sollte die X-Achsenrichtung nicht fix über die Ursprungs X-Achse definiert werden. Da ist noch viel Arbeit übrig. 

Code:

---

Option Explicit on

Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As PartDocument = oApp.ActiveDocument
Dim oCompDef As SheetMetalComponentDefinition= oDoc.ComponentDefinition

If oCompDef.Features.PunchToolFeatures.Count = 0 Then
    Call MsgBox("No punches.", vbInformation)
    Exit Sub
End If
   
' Create an AnnotationPlaneDef
' Definition is reused for each annotation
Dim oAnnoPlaneDef As AnnotationPlaneDefinition = oCompDef.ModelAnnotations.CreateAnnotationPlaneDefinitionUsingPlane(oCompDef.WorkPlanes.Item(3), oCompDef.WorkAxes.Item(1)) 'XY-Ebene, X-Achse

' Get the Origin
Dim oOrigin As WorkPoint= oCompDef.WorkPoints.Item(1)

' Create a GeometryIntent of the origin
Dim oIntent1 As GeometryIntent = oCompDef.CreateGeometryIntent(oOrigin)

' Set a reference to the LinearModelDimensions
Dim oLinModelDims As LinearModelDimensions = oCompDef.ModelAnnotations.ModelDimensions.LinearModelDimensions

' Traverse the PunchToolFeatures
Dim oFeat As PunchToolFeature
For Each oFeat In oCompDef.Features.PunchToolFeatures
    ' get the CenterPoints collection
    Dim oColl As ObjectCollection = oFeat.PunchCenterPoints
   
    Dim oPoint As SketchPoint
    For Each oPoint In oColl
        Dim oIntent2 As GeometryIntent = oCompDef.CreateGeometryIntent(oPoint)
        Dim oSketch As PlanarSketch= oPoint.Parent
        Dim oModelPoint As Point = oSketch.SketchToModelSpace(oPoint.Geometry)
        Dim oTextPos As Point
        Dim oLinModelDimDef As LinearModelDimensionDefinition
        Dim oLinModelDim As LinearModelDimension
       
        ' horizontal
        oTextPos = oApp.TransientGeometry.CreatePoint(oModelPoint.X / 2, -oModelPoint.Y, 0)
        oLinModelDimDef = oLinModelDims.CreateDefinition(oIntent1, oIntent2, oAnnoPlaneDef, oTextPos, kHorizontalDimensionType)
        oLinModelDim = oLinModelDims.Add(oLinModelDimDef)
       
        ' vertical
        oTextPos = oApp.TransientGeometry.CreatePoint(-oModelPoint.X, oModelPoint.Y / 2, 0)
        oLinModelDimDef = oLinModelDims.CreateDefinition(oIntent1, oIntent2, oAnnoPlaneDef, oTextPos, kVerticalDimensionType)
        oLinModelDim = oLinModelDims.Add(oLinModelDimDef)
    Next
Next

---

------------------
MfG
Ralf

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

---

Guten Morgen, herzlich Dank....

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

---

22-11-2024_10-06-02.jpg

Guten Morgen, funktioniert das auch bei ifeature?

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

---

Moin

Nö, denen fehlt die CenterPoints Collection. Wenn die Skizze (ich gehe davon aus es gibt nur eine im iFeature) um den Ursprung gezeichnet ist, könnte man den benutzen. Ansonsten könnte man an die entsprechende Stelle einen Mittelpunkt setzen. Wenn es mehrere Mittelpunkte, warum auch immer in der Skizze gibt, bleibt fast nur die Möglichkeit diesem einen Mittelpunkt ein Attribut zu verpassen. Damit ist er eindeutig identifizierbar und über den AttributeManager findet man ihn relativ easy wieder. Das würde auch funktionieren, wenn es mehrere Skizzen gibt.

------------------
MfG
Ralf

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

---

25-11-2024_14-14-52.jpg MusterUBlech.ipt

Hi, im Anhang befindet sich eine Datei(IPT_V23), mit einer Muster-Bemaßung. So in etwa, soll das Aussehen!

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

---

Moin

Hast du eine Lösung gefunden? Oder sollte ich jetzt den ganzen Code schreiben?
Wie positionierst du die iFeature beim Einfügen? Ich vermute das passiert auch per Code? An dem Punkt mußt du ja von irgendwoher auch die Einfügeebene und die Position haben.
Ich würde überlegen ob ich das iFeature anders definiere. Den Kreis in der Skizze vom Skizzenursprung seitlich versetzen und je eine Bemaßung in X- und Y-Richtung zum Skizzenurspung einfügen. Der Bemaßungswert ist unerheblich. Den Mittelpunkt des Kreises als Mittelpunkt markieren. Beim Extrahieren des iFeatures den Referenzpunkt Skizzenursprung, die Einfügeebene, den Durchmesser und die 2 Bemaßungen mitnehmen.
Wenn man dieses iFeature eingefügt hat, kann man daraus die Werte:
- AnnotationPlane aus der Sketch.PlanarEntityGeometry
- AnnotationEntityOne aus dem Sketch.RootPoint
- AnnotationEntityTwo aus dem Sketch.SketchPoints.Item(x).Geometry3d (der als Mittelpunkt markierte Mittelpunkt des Kreises)
für die Modellanmerkung holen. Also rein hypothetisch. 

------------------
MfG
Ralf

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

---

04-12-2024_10-17-21.jpg

Guten Morgen, puuuuuhhh das wäre echt genial....
Und ja ich setze die iFeature mit einem code!!!
Das Model hat ebenen (die sind in der Regel nicht sichtbar) Im Namen des iFeature ist der Ebenen-Name versteckt. (z.B. iFeature "B01_T"= Ebene Tiefe)
Der Nullpunkt ist auf dem beigefügten Bild zu sehen, und dort ist er auch immer!
Die Bearbeitung sind nicht immer Rundlöcher, sondern auch Langlöcher + Rechtecke.
Wenn die Bemaßung platziert wird, sollt das auch ebenen bezogen dargestellt werden, so wie in der IPT, die ich schon hier veröffentlich habe.
Zum Verständnis, wenn ein iFeature vorhanden ist, dann soll eine Regel im IV-Ereignisauslöser per code die Bemaßung generieren.
Und echt super, dass du mich unterstützt....

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

---

Moin

Ich hatte heute etwas Zeit damit herumzuspielen. Erstmal "nur" in VBA. Vieles ist noch hart kodiert und passt deswegen nur auf genau diese eine Beispieldatei. Ein paar Sachen gehen mit VB einfacher, aber dafür ist Debuggen in iLogic umständlicher.
Bei Langlöchern oder Rechtecken usw. würde wie bei den Kreisen nur der Mittelpunkt bemaßt. Ebenso fehlt bei den Löchern noch der Durchmesser.
Die iFeature werden eingelesen und jeweils Bemaßungen in X- und Y-Richtung erstellt. Doppelte Maße (mit gleichem Wert) auf einer Anmerkungsebene werden ausgefiltert. Die Bemaßungen je Ebene werden aufsteigend sortiert. Je nach Betrachtungswinkel bilden die Bemaßungen trotzdem einen wilden unleserlichen Haufen. Das läßt sich nicht verweiden.
Ich bin trotzdem der Meinung, da du beim Einfügen des jeweiligen iFeatures bereits die Einfügeebene und die Koordinaten hast, solltest du die Bemaßung direkt mit den vorhandenen Informationen erstellen. Die Informationen hinterher wieder zusammensuchen zu müssen, ist mM vermeidbarer Aufwand.

Code:

---

Private Sub AddLinearModelDims()

Dim oApp As Inventor.Application
Set oApp = ThisApplication

Dim oDoc As PartDocument
Set oDoc = oApp.ActiveDocument

Dim oCompDef As SheetMetalComponentDefinition
Set oCompDef = oDoc.ComponentDefinition

If oCompDef.Features.iFeatures.Count = 0 Then
    Call MsgBox("No iFeatures.", vbInformation)
    Exit Sub
End If
   
' Create 3 AnnotationPlaneDef
' Definition is reused by copying for each annotation
Dim oAnnoPlaneDef As AnnotationPlaneDefinition

Dim oAnnoPlaneDef_hoehe1 As AnnotationPlaneDefinition
Set oAnnoPlaneDef_hoehe1 = oCompDef.ModelAnnotations.CreateAnnotationPlaneDefinitionUsingPlane(oCompDef.WorkPlanes.Item("hoehe_1"), oCompDef.WorkAxes.Item(1)) 'Arbeitsebene "hoehe_1", X-Achse

Dim oAnnoPlaneDef_hoehe2 As AnnotationPlaneDefinition
Set oAnnoPlaneDef_hoehe2 = oCompDef.ModelAnnotations.CreateAnnotationPlaneDefinitionUsingPlane(oCompDef.WorkPlanes.Item("hoehe_2"), oCompDef.WorkAxes.Item(1)) 'Arbeitsebene "hoehe_2", X-Achse

Dim oAnnoPlaneDef_tiefe As AnnotationPlaneDefinition
Set oAnnoPlaneDef_tiefe = oCompDef.ModelAnnotations.CreateAnnotationPlaneDefinitionUsingPlane(oCompDef.WorkPlanes.Item("tiefe"), oCompDef.WorkAxes.Item(2)) 'Arbeitsebene "tiefe", Y-Achse

' Get the Origin
Dim oOrigin As WorkPoint
Set oOrigin = oCompDef.WorkPoints.Item(1)

' Create a GeometryIntent of the origin
Dim oIntent1 As GeometryIntent
Set oIntent1 = oCompDef.CreateGeometryIntent(oOrigin)

Dim oLinModelDims As LinearModelDimensions
Set oLinModelDims = oCompDef.ModelAnnotations.ModelDimensions.LinearModelDimensions

Dim dTextOffset As Double
dTextOffset = 10

' create an array of ifeatures with unique coordinates
Dim H1_x() As Variant
Dim H1_z() As Variant
Dim H2_x() As Variant
Dim H2_z() As Variant
Dim T_x() As Variant
Dim T_y() As Variant

Dim oiFeat As iFeature
For Each oiFeat In oCompDef.Features.iFeatures
    Dim sNameParts() As String
        sNameParts = Split(oiFeat.Name, "_")
       
        Dim sName As String
        sName = UCase(Left(sNameParts(UBound(sNameParts)), InStr(sNameParts(UBound(sNameParts)), ":") - 1))
       
        Select Case sName
            Case "H1":
                Call AddToArray(oiFeat, oCompDef, "X", H1_x)
                Call AddToArray(oiFeat, oCompDef, "Z", H1_z)
            Case "H2":
                Call AddToArray(oiFeat, oCompDef, "X", H2_x)
                Call AddToArray(oiFeat, oCompDef, "Z", H2_z)
            Case "T":
                Call AddToArray(oiFeat, oCompDef, "X", T_x)
                Call AddToArray(oiFeat, oCompDef, "Y", T_y)
        End Select
Next

' sort all arrays in ascending order
Call BubbleSort(H1_x, "X")
Call BubbleSort(H1_z, "Z")
Call BubbleSort(H2_x, "X")
Call BubbleSort(H2_z, "Z")
Call BubbleSort(T_x, "X")
Call BubbleSort(T_y, "Y")

Dim aFeatArrs(0 To 5, 1) As Variant
aFeatArrs(0, 0) = H1_x
aFeatArrs(0, 1) = "X"
aFeatArrs(1, 0) = H1_z
aFeatArrs(1, 1) = "Z"
aFeatArrs(2, 0) = H2_x
aFeatArrs(2, 1) = "X"
aFeatArrs(3, 0) = H2_z
aFeatArrs(3, 1) = "Z"
aFeatArrs(4, 0) = T_x
aFeatArrs(4, 1) = "X"
aFeatArrs(5, 0) = T_y
aFeatArrs(5, 1) = "Y"

Dim i As Integer
Dim aFeatArr As Variant
Dim sAxis As String
For i = 0 To UBound(aFeatArrs)
    aFeatArr = aFeatArrs(i, 0)
    sAxis = aFeatArrs(i, 1)
    Dim oFeat As Variant
    For Each oFeat In aFeatArr
        If oFeat.Suppressed = False Then
            Dim oPoint As SketchPoint
            Set oPoint = oFeat.Sketches(1).SketchPoints(1)
           
            Dim oIntent2 As GeometryIntent
            Set oIntent2 = oCompDef.CreateGeometryIntent(oPoint)
       
            Dim oModelPoint As Point
            Set oModelPoint = oIntent2.Point
       
            Dim oTextPosH As Point
            Dim oTextPosV As Point
            Dim oLinModelDimDef As LinearModelDimensionDefinition
            Dim oLinModelDim As LinearModelDimension
           
            ' die letzte verwendete Textposision, damit die nächste berechnet werden kann
            Dim oTextPos_H1_H As Point '
            Dim oTextPos_H1_V As Point
            Dim oTextPos_H2_H As Point
            Dim oTextPos_H2_V As Point
            Dim oTextPos_T_H As Point
            Dim oTextPos_T_V As Point
           
            'Dim sNameParts() As String
            sNameParts = Split(oFeat.Name, "_")
           
            'Dim sName As String
            sName = UCase(Left(sNameParts(UBound(sNameParts)), InStr(sNameParts(UBound(sNameParts)), ":") - 1))
           
            Select Case sName
                Case "H1":
                    Set oAnnoPlaneDef = oAnnoPlaneDef_hoehe1
                    If sAxis = "X" Then
                        'horizontal
                        If oTextPos_H1_H Is Nothing Then
                            Set oTextPos_H1_H = oApp.TransientGeometry.CreatePoint(oModelPoint.X / 2, oModelPoint.Y, oModelPoint.Z + 10)
                        Else
                            Set oTextPos_H1_H = oApp.TransientGeometry.CreatePoint(oModelPoint.X / 2, oModelPoint.Y, oTextPos_H1_H.Z + 10)
                        End If
                       
                        Set oLinModelDimDef = oLinModelDims.CreateDefinition(oIntent1, oIntent2, oAnnoPlaneDef, oTextPos_H1_H, kHorizontalDimensionType)
                        Set oLinModelDim = oLinModelDims.Add(oLinModelDimDef)
                        dTextOffset = oLinModelDimDef.Text.Size * 2
                    ElseIf sAxis = "Z" Then
                        'vertical
                        If oTextPos_H1_V Is Nothing Then
                            Set oTextPos_H1_V = oApp.TransientGeometry.CreatePoint(-oModelPoint.X - 10, oModelPoint.Y, oModelPoint.Z / 2)
                        Else
                            Set oTextPos_H1_V = oApp.TransientGeometry.CreatePoint(oTextPos_H1_V.X - 10, oModelPoint.Y, oModelPoint.Z / 2)
                        End If
                       
                        Set oLinModelDimDef = oLinModelDims.CreateDefinition(oIntent1, oIntent2, oAnnoPlaneDef, oTextPos_H1_V, kVerticalDimensionType)
                        Set oLinModelDim = oLinModelDims.Add(oLinModelDimDef)
                        dTextOffset = oLinModelDimDef.Text.Size * 2
                    End If
           
                Case "H2":
                    Set oAnnoPlaneDef = oAnnoPlaneDef_hoehe2
                    If sAxis = "X" Then
                        'horizontal
                        If oTextPos_H2_H Is Nothing Then
                            Set oTextPos_H2_H = oApp.TransientGeometry.CreatePoint(oModelPoint.X / 2, oModelPoint.Y, oModelPoint.Z + 10)
                        Else
                            Set oTextPos_H2_H = oApp.TransientGeometry.CreatePoint(oModelPoint.X / 2, oModelPoint.Y, oTextPos_H2_H.Z + 10)
                        End If
                       
                        Set oLinModelDimDef = oLinModelDims.CreateDefinition(oIntent1, oIntent2, oAnnoPlaneDef, oTextPos_H2_H, kHorizontalDimensionType)
                        Set oLinModelDim = oLinModelDims.Add(oLinModelDimDef)
                        dTextOffset = oLinModelDimDef.Text.Size * 2
                    ElseIf sAxis = "Z" Then
                        'vertical
                        If oTextPos_H2_V Is Nothing Then
                            Set oTextPos_H2_V = oApp.TransientGeometry.CreatePoint(-oModelPoint.X - 10, oModelPoint.Y, oModelPoint.Z / 2)
                        Else
                            Set oTextPos_H2_V = oApp.TransientGeometry.CreatePoint(oTextPos_H2_V.X - 10, oModelPoint.Y, oModelPoint.Z / 2)
                        End If
                       
                        Set oLinModelDimDef = oLinModelDims.CreateDefinition(oIntent1, oIntent2, oAnnoPlaneDef, oTextPos_H2_V, kVerticalDimensionType)
                        Set oLinModelDim = oLinModelDims.Add(oLinModelDimDef)
                        dTextOffset = oLinModelDimDef.Text.Size * 2
                    End If
           
                Case "T":
                    Set oAnnoPlaneDef = oAnnoPlaneDef_tiefe
                    If sAxis = "Y" Then
                        'horizontal
                        If oTextPos_T_H Is Nothing Then
                            Set oTextPos_T_H = oApp.TransientGeometry.CreatePoint(-oModelPoint.X + 10, oModelPoint.Y / 2, oModelPoint.Z)
                        Else
                            Set oTextPos_T_H = oApp.TransientGeometry.CreatePoint(oTextPos_T_H.X + 10, oModelPoint.Y / 2, oModelPoint.Z)
                        End If
                       
                        Set oLinModelDimDef = oLinModelDims.CreateDefinition(oIntent1, oIntent2, oAnnoPlaneDef, oTextPos_T_H, kHorizontalDimensionType)
                        Set oLinModelDim = oLinModelDims.Add(oLinModelDimDef)
                        dTextOffset = oLinModelDimDef.Text.Size * 2
                    ElseIf sAxis = "X" Then
                        'vertical
                        If oTextPos_T_V Is Nothing Then
                            Set oTextPos_T_V = oApp.TransientGeometry.CreatePoint(oModelPoint.X / 2, -oModelPoint.Y - 10, oModelPoint.Z)
                        Else
                            Set oTextPos_T_V = oApp.TransientGeometry.CreatePoint(oModelPoint.X / 2, oTextPos_T_V.Y - 10, oModelPoint.Z)
                        End If
                       
                        Set oLinModelDimDef = oLinModelDims.CreateDefinition(oIntent1, oIntent2, oAnnoPlaneDef, oTextPos_T_V, kVerticalDimensionType)
                        Set oLinModelDim = oLinModelDims.Add(oLinModelDimDef)
                        dTextOffset = oLinModelDimDef.Text.Size * 2
                    End If
            End Select
        End If
    Next
Next

End Sub

Private Sub AddToArray(ByVal oFeat As iFeature, ByVal oCompDef As ComponentDefinition, ByVal sAxis As String, ByRef aArray() As Variant)
    Dim oPoint1 As SketchPoint
    Set oPoint1 = oFeat.Sketches(1).SketchPoints(1)
   
    Dim oIntent1 As GeometryIntent
    Set oIntent1 = oCompDef.CreateGeometryIntent(oPoint1)
   
    If (Not Not aArray) = 0 Then
        ReDim Preserve aArray(0 To 0)
    Else
        Dim oItem As Variant 'iFeature
        For Each oItem In aArray
            Dim oPoint2 As SketchPoint
            Set oPoint2 = oItem.Sketches(1).SketchPoints(1)
       
            Dim oIntent2 As GeometryIntent
            Set oIntent2 = oCompDef.CreateGeometryIntent(oPoint2)
                 
            If sAxis = "X" Then
                If oIntent1.Point.X = oIntent2.Point.X Then
                    Exit Sub
                End If
            ElseIf sAxis = "Y" Then
                If oIntent1.Point.Y = oIntent2.Point.Y Then
                    Exit Sub
                End If
            Else
                If oIntent1.Point.Z = oIntent2.Point.Z Then
                    Exit Sub
                End If
            End If
        Next
               
        ReDim Preserve aArray(UBound(aArray) + 1)
    End If
   
    Set aArray(UBound(aArray)) = oFeat
   
End Sub

Sub BubbleSort(ByRef MyArray() As Variant, sAxis As String)
'Sorts a one-dimensional VBA array from smallest to largest
'using the bubble sort algorithm.
Dim i As Long, j As Long
Dim Temp As Variant

For i = LBound(MyArray) To UBound(MyArray) - 1
    For j = i + 1 To UBound(MyArray)
        If sAxis = "X" Then
            If Abs(MyArray(i).Sketches(1).OriginPointGeometry.X) > Abs(MyArray(j).Sketches(1).OriginPointGeometry.X) Then
                Set Temp = MyArray(j)
                Set MyArray(j) = MyArray(i)
                Set MyArray(i) = Temp
            End If
        ElseIf sAxis = "Y" Then
            If Abs(MyArray(i).Sketches(1).OriginPointGeometry.Y) > Abs(MyArray(j).Sketches(1).OriginPointGeometry.Y) Then
                Set Temp = MyArray(j)
                Set MyArray(j) = MyArray(i)
                Set MyArray(i) = Temp
            End If
        Else
            If Abs(MyArray(i).Sketches(1).OriginPointGeometry.Z) > Abs(MyArray(j).Sketches(1).OriginPointGeometry.Z) Then
                Set Temp = MyArray(j)
                Set MyArray(j) = MyArray(i)
                Set MyArray(i) = Temp
            End If
        End If
    Next j
Next i
End Sub

---

------------------
MfG
Ralf

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

---

Hi Ralf, danke für deine Mühe...Ich kuck gleich mal, was du da für mich gezaubert hast.

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