---

gearObjects2Object.txt

Hallo,

wie bekomm ich mit ob der momentan ein BKS definiert und wie transformiere ich am schlausten einen Winkel.

Hab hab folgendes kleines Programm was (M)Texte und Schraffuren anhand anderer Objekte ausrichtet nur leider funktioniert es nicht korrekt wenn ein BKS eingestellt ist

Code:

---

Option Explicit On

' ###################################################################################################
' #                                                                                                 #
' #   Methoden um ein oder mehrere Objekte nach einem anderen Objekt auszurichten                   #
' #                                                                                                 #
' #   Akzeptierte Referenzobjekte:                                                                  #
' #     - 2 Punkte (als Keyword)                                                                    #
' #     - Blockreferenz                                                                             #
' #     - Text, MText, XText                                                                        #
' #     - Schraffur                                                                                 #
' #     - Linie, Konstruktionslinie                                                                 #
' #     - LW-Polylinie, 2D- und 3D-Polylinie                                                        #
' #     - Bogen, Kreis, Ellipse                                                                     #
' #                                                                                                 #
' #   Zu drehende Objekte                                                                           #
' #     - Blöcke                                                                                    #
' #     - Texte, MTexte, XTexte                                                                     #
' #     - Schraffuren                                                                               #
' #                                                                                                 #
' #   Funktionen                                                                                    #
' #     - gearObjects2Object()                                                                      #
' #     - gearAngleFromPoints(Double) as Boolean                                                    #
' #     - getAngleFromObject(Double, PromptEntityResult)) as Boolean                                #
' #                                                                                                 #
' #   Stand: 07.12.2009                                                                             #
' ###################################################################################################

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry

' Verringern der Ladezeit beim Kompilieren
<Assembly: CommandClass(GetType(LaOs_AutoCAD_Werkzeuge.gearObjects2Object))>

Namespace LaOs_AutoCAD_Werkzeuge
    Module gearObjects2Object

        ' Aufruf der Funktion über 'gearObjects2Object' möglich
        ' Methode zum Aufrufen der Funktion um ein oder mehrere Objekte nach einem Objekt auszurichten
        '   - Fragt das Referenzobjekt ab: Block, (M-,X-)Text, Schraffur, (K)Linie, (2D-,3D-)Polylinien, Bogen, Kreis, Ellipse oder anhand zweier Punkten
        '   - Bestimmt den Winkel des Objekte und überträgt ihn auf die ausgewählten (M-,X-)Texte, Schraffurern und Blöcke
        <CommandMethod("gearObjects2Object")> _
        Public Sub gearObjects2Object()

            Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor

            '---------------------------------------------------------------
            ' Abfragen des Objektes von dem der Winkel übernommen werden soll
            '---------------------------------------------------------------

            Dim referenzAngle As Double

            ' Auch Objekte auf gesperrten Layern und Keyword: Punkte
            Dim getRefObjectOptions As New PromptEntityOptions(ControlChars.CrLf & "Bitte das Referenzobjekt auswählen oder ")
            getRefObjectOptions.AllowObjectOnLockedLayer = True
            getRefObjectOptions.Keywords.Add("Punkte")

            ' Auswahl des Referenzobjektes durch den Benutzer
            Dim getRefObjectResult As PromptEntityResult = editor.GetEntity(getRefObjectOptions)

            ' Abbruch der Funktion durch Benutzer
            If (getRefObjectResult.Status = PromptStatus.Cancel) Then
                ' Beenden der Methode
                Exit Sub
            ' Schlüsselwort eingegeben
            ElseIf (getRefObjectResult.Status = PromptStatus.Keyword) Then
               ' Richtungswinkel soll anhand zweier Punkte bestimmt werden
                If (getRefObjectResult.StringResult = "Punkte") Then
                    ' Aufruf der Funktion um den Winkel anhand zweier Punkte zu bestimmen
                    If Not (getAngleFromPoints(referenzAngle)) Then
                        ' Beenden der Methode
                        Exit Sub
                    End If
                Else
                    ' Beenden der Metohode
                    Exit Sub
                End If
            ' Objekt ausgewählt
            ElseIf (getRefObjectResult.Status = PromptStatus.OK) Then
                ' Aufruf der Funktion um den Winkel anhand eines Referenzobjekt zu bestimmen
                If Not (getAngleFromObject(referenzAngle, getRefObjectResult)) Then
                    ' Beenden der Methode
                    Exit Sub
                End If
            ' Ungültige Eingabe des Benutzers
            Else
                editor.WriteMessage(ControlChars.CrLf & "Kein gültiges Objekt oder Schlüsselwort eingegeben")
                ' Beenden der Methode
                Exit Sub
            End If

            ' Referenzwinkel wurde bestimmt und wird dem Benutzer ausgegeben
            editor.WriteMessage(ControlChars.CrLf & "Es konnte ein Referenzwinkel von " & Converter.AngleToString(referenzAngle, AngularUnitFormat.Current, Application.DocumentManager.MdiActiveDocument.Database.Auprec) & " extrahiert werden")

            '---------------------------------------------------------------
            ' Abfragen der zu drehenden Objekte
            '---------------------------------------------------------------

            ' Nur Blöcke, Texte und Schraffuren als wählbare Objekte zulassen
            Dim filterValues(0 To 6) As TypedValue
            filterValues(0) = New TypedValue(DxfCode.Operator, "<OR")
            filterValues(1) = New TypedValue(0, "INSERT")
            filterValues(2) = New TypedValue(0, "MTEXT")
            filterValues(3) = New TypedValue(0, "TEXT")
            filterValues(4) = New TypedValue(0, "XTEXT")
            filterValues(5) = New TypedValue(0, "HATCH")
            filterValues(6) = New TypedValue(DxfCode.Operator, "OR>")

            ' Auch Objekte auf gesperrten Layern
            Dim getObjectsSelectionOptions As New PromptSelectionOptions
            getObjectsSelectionOptions.MessageForAdding = ControlChars.CrLf & "Bitte die zu drehende Blöcke, (M-,X-)Texte oder Schraffuren auswählen"
            getObjectsSelectionOptions.RejectObjectsOnLockedLayers = False

            ' Auswahl der zu drehenden Objekte durch den Benutzer
            Dim getObjectsSelectionResult As PromptSelectionResult = editor.GetSelection(getObjectsSelectionOptions, New SelectionFilter(filterValues))

            ' Abbruch der Funktion durch Benutzer
            If (getObjectsSelectionResult.Status = PromptStatus.Cancel) Then
                ' Beenden der Methode
                Exit Sub
            ' Kein gültiges Objekt ausgewählt
            ElseIf Not (getObjectsSelectionResult.Status = PromptStatus.OK) Then
                editor.WriteMessage(ControlChars.CrLf & "Sie haben kein gültiges Objekt zum Drehen ausgewählt")
                ' Beenden der Methode
                Exit Sub
            End If

             ' Wenn mind. ein Objekt zum Drehen ausgewählt wurden
            If Not IsNothing(getObjectsSelectionResult.Value) Then

                ' Standartmäßig sollen nur Objekte auch nicht-gesperrten Layern bearbeitet werden
                Dim editLockedObjects As Boolean = False

                ' Prüfen ob Objekte auch gesperrten Layern liegen und Abfrage ob diese ebenfalls bearbeitet werden sollen
                If (Functions.isOnLockedLayer(getObjectsSelectionResult.Value)) Then
                    If (MsgBox("Es befinden sich Objekte auf gesperrten Layern." & ControlChars.CrLf & ControlChars.CrLf & "Sollen diese ebenfalls nach dem Referenzobjekt ausgerichtet werden?", MsgBoxStyle.YesNo, "Objekt(e) auf gesperrten Layer(n)") = MsgBoxResult.Yes) Then
                        editLockedObjects = True
                    End If
                End If

                ' Zähler um die Anzahl der gedrehten Objekte zu bestimmen
                Dim zaehlerBlöcke As Long = 0
                Dim zaehlerTexte As Long = 0
                Dim zaehlerSchraffuren As Long = 0

                ' Anlegen eines Transaktionsobjektes um auf die Zeichnungsdatenbank zugreifen zu können
                Dim trans As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction
                Try
                    For i As Long = 0 To getObjectsSelectionResult.Value.Count - 1
                        ' Holen des Elementes aus der Datenbank - Schreibrechte
                        Dim entity As Entity = getObjectsSelectionResult.Value.Item(i).ObjectId.GetObject(OpenMode.ForWrite, False, editLockedObjects)
                        ' Überprüfen was für ein Objekt ausgewählt wurde
                        Select Case entity.GetType().FullName
                            ' Wenn es eine Blockreference ist
                            Case "Autodesk.AutoCAD.DatabaseServices.BlockReference"
                                Dim blockRef As BlockReference = entity
                                blockRef.Rotation = referenzAngle
                                zaehlerBlöcke += 1
                            ' Wenn es ein normaler Text oder ein XText ist
                            Case "Autodesk.AutoCAD.DatabaseServices.DBText"
                                Dim text As DBText = entity
                                text.Rotation = referenzAngle
                                zaehlerTexte += 1
                            ' Wenn es ein MText ist
                            Case "Autodesk.AutoCAD.DatabaseServices.MText"
                                Dim mtext As MText = entity
                                mtext.Rotation = referenzAngle
                                zaehlerTexte += 1
                            ' Wenn es eine Schraffur ist
                            Case "Autodesk.AutoCAD.DatabaseServices.Hatch"
                                Dim hatch As Hatch = entity
                                hatch.PatternAngle = referenzAngle
                                zaehlerSchraffuren += 1
                        End Select
                    Next

                    ' Bestätigen der Drehungen
                    trans.Commit()

                ' Abfangen eines evtl. auftretenden Fehlers
                Catch ex As System.Exception
                    editor.WriteMessage(ControlChars.CrLf & "Fehler beim Drehen eines Objektes" & ControlChars.CrLf & ex.Message & ControlChars.CrLf & "Funktion: gearObjects2Object()")

                ' Schließen der Transaktion mit der Datenbank
                Finally
                    trans.Dispose()
                End Try

                editor.WriteMessage(ControlChars.CrLf & "Es konnten " & zaehlerBlöcke & " Blöcke, " & zaehlerTexte & " Texte und " & zaehlerSchraffuren & " Schraffuren gedreht werden")
            End If

        End Sub

        ' Funktion um zwei Punkte vom Benutzer abzufragen und daraus einen Richtungswinkel zu bestimmen
        '   - Benötigt eine Variable vom Typ Double in welcher der Winkel gespeichert werden soll
        '   - Gibt TRUE zurück falls erfolgreich, FALSE bei nicht erfolgreich
        Private Function getAngleFromPoints(ByRef referenzAngle As Double) As Boolean

            Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor

            '---------------------------------------------------------------
            ' Abfragen des ersten Punktes                                               
            '---------------------------------------------------------------

            ' Eingabe des ersten Punktes durch den Benutzer
            Dim getPointResult As PromptPointResult = editor.GetPoint(ControlChars.CrLf & "Bitte den ersten Punkt auswählen: ")

            ' Abbruch der Funktion durch Benutzer
            If (getPointResult.Status = PromptStatus.Cancel) Then
                ' Beenden der Funktion
                Return False
            ' Keinen gültigen ersten Punkt eingegeben
            ElseIf Not (getPointResult.Status = PromptStatus.OK) Then
                editor.WriteMessage(ControlChars.CrLf & "Sie haben keinen gültigen ersten Punkt ausgewählt")
                ' Beenden der Funktion
                Return False
            End If

            ' Gültiger Punkt ausgewählt
            Dim fromPoint3D As Point3d = getPointResult.Value
            editor.WriteMessage(Functions.Point3D2String(fromPoint3D, DistanceUnitFormat.Current, Application.DocumentManager.MdiActiveDocument.Database.Luprec))

            '---------------------------------------------------------------
            ' Abfragen des zweiten Punktes                                               
            '---------------------------------------------------------------

            ' Zweiter Punkt soll mit Hilfslinie vom ersten Punkt aus ausgewählt werden
            Dim getPointOptions As PromptPointOptions = New PromptPointOptions(ControlChars.CrLf & "Bitte den zweiten Punkt auswählen: ")
            getPointOptions.BasePoint = fromPoint3D
            getPointOptions.UseBasePoint = True

            ' Eingabe des zweiten Punktes durch den Benutzer
            getPointResult = editor.GetPoint(getPointOptions)

            ' Abbruch der Funktion durch Benutzer
            If (getPointResult.Status = PromptStatus.Cancel) Then
                ' Beenden der Funktion
                Return False
            ' Keinen gültigen zweiten Punkt eingegeben
            ElseIf Not (getPointResult.Status = PromptStatus.OK) Then
                editor.WriteMessage(ControlChars.CrLf & "Sie haben keinen gültigen zweiten Punkt ausgewählt")
                ' Beenden der Funktion
                Return False
            End If

            ' Gültiger Punkt ausgewählt
            Dim toPoint3D As Point3d = getPointResult.Value
            editor.WriteMessage(Functions.Point3D2String(toPoint3D, DistanceUnitFormat.Current, Application.DocumentManager.MdiActiveDocument.Database.Luprec))

            '---------------------------------------------------------------
            ' Wenn die beiden Punkte nicht identisch sind wird der Richtungswinkel bestimmt                                              
            '---------------------------------------------------------------

            If (fromPoint3D.IsEqualTo(toPoint3D)) Then
                editor.WriteMessage(ControlChars.CrLf & "Sie haben zwei identische Punkte ausgewählt. Winkelbestimmung nicht möglich")
                ' Beenden der Function
                Return False
            End If

            ' Bestimmen des Richtungswinkels
            referenzAngle = Functions.getRichtungswinkel2D(fromPoint3D, toPoint3D)
            Return True

        End Function

        ' Funktion um von einem vom Benutzer abgefragtes Objekt einen Richtungswinkel zu bestimmen
        '   - Unterstützte Objekte: Block, (M-,X-)Text, Schraffur, (K)Linie, (2D-,3D-)Polylinien, Bogen, Kreis, Ellipse
        '   - Benötigt eine Variable vom Typ Double in welcher der Winkel gespeichert werden soll sowie das vom Benutzer ausgewählte Referenzobjekt
        '   - Gibt TRUE zurück falls erfolgreich, FALSE bei nicht erfolgreich
        Private Function getAngleFromObject(ByRef referenzAngle As Double, ByVal refObjectResult As PromptEntityResult) As Boolean

            Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor

            ' Anlegen eines Transaktionsobjektes um auf die Zeichnungsdatenbank zugreifen zu können
            Dim trans As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction
            Try
                ' Holen des Elementes aus der Datenbank - Leserechte
                Dim entity As Entity = refObjectResult.ObjectId.GetObject(OpenMode.ForRead)

                ' Überprüfen was für ein Objekt ausgewählt wurde
                Select Case entity.GetType().FullName
                    ' Wenn es eine Blockreference ist
                    Case "Autodesk.AutoCAD.DatabaseServices.BlockReference"
                        Dim blockRef As BlockReference = entity
                        referenzAngle = blockRef.Rotation
                        Return True
                    ' Wenn es ein normaler Text oder ein XText ist
                    Case "Autodesk.AutoCAD.DatabaseServices.DBText"
                        Dim text As DBText = entity
                        referenzAngle = text.Rotation
                        Return True
                    ' Wenn es ein MText ist
                    Case "Autodesk.AutoCAD.DatabaseServices.MText"
                        Dim mtext As MText = entity
                        referenzAngle = mtext.Rotation
                        Return True
                    ' Wenn es eine Schraffur ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Hatch"
                        Dim hatch As Hatch = entity
                        referenzAngle = hatch.PatternAngle
                        Return True
                    ' Wenn es eine Linie ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Line"
                        Dim line As Line = entity
                        ' Berechnen des Winkels
                        referenzAngle = Functions.getRichtungswinkel2D(line.StartPoint, line.EndPoint)
                        ' Evtl. Winkel um Pi ehöhen falls der Endpunkt der Linie näher am PickedPoint liegt
                        If (Functions.getDistance2D(line.EndPoint, refObjectResult.PickedPoint) < Functions.getDistance2D(line.StartPoint, refObjectResult.PickedPoint)) Then
                            referenzAngle += Math.PI
                        End If
                        Return True
                    ' Wenn es eine Konstruktionlinie ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Xline"
                        Dim xline As Xline = entity
                        ' Berechnen des Winkels
                        referenzAngle = Functions.getRichtungswinkel2D(xline.BasePoint, xline.SecondPoint)
                        ' Evtl. Winkel um Pi erhöhen falls der Endpunkt der Konstruktionslinie näher am PickedPoint liegt
                        If (Functions.getDistance2D(xline.SecondPoint, refObjectResult.PickedPoint) < Functions.getDistance2D(xline.BasePoint, refObjectResult.PickedPoint)) Then
                            referenzAngle += Math.PI
                        End If
                        Return True
                    ' Wenn es eine normale Polylinie ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Polyline"
                        Dim polyline As Polyline = entity
                        ' Den dichtesten Punkt der Polyline zum PickedPoint bestimmen
                        Dim pointOnLine As Point3d = polyline.GetClosestPointTo(refObjectResult.PickedPoint, True)
                        ' Durchlaufen aller Liniensegmente der Polyline (-2 falls nicht geschlossen, -1 sonst)
                        For i As Long = 0 To polyline.NumberOfVertices - IIf(Not polyline.Closed, 2, 1)
                            ' Prüfen ob der Punkt auf der Linie ein Stützpunkt ist
                            If (pointOnLine.IsEqualTo(polyline.GetPoint3dAt(i)) Or pointOnLine.IsEqualTo(polyline.GetPoint3dAt((i + 1) Mod (polyline.NumberOfVertices - 1)))) Then
                                editor.WriteMessage(ControlChars.CrLf & "Sie haben einen Stützpunkt der Polyline ausgewählt. Winkelbestimmung nicht eindeutig.")
                                ' Beenden der Funktion
                                Return False
                            End If
                            ' Prüfen ob der Punkt auf der Linie zwischen 2 Punkten liegt
                            If (polyline.GetLineSegmentAt(i).IsOn(pointOnLine)) Then
                                ' Bestimmen des Winkels
                                referenzAngle = Functions.getRichtungswinkel2D(polyline.GetLineSegmentAt(i).StartPoint, polyline.GetLineSegmentAt(i).EndPoint)
                                ' Evtl. Winkel um Pi ehöhen falls der Punkt auf der Linie näher am zweiten Punkt der Linie liegt
                                If (Functions.getDistance2D(polyline.GetLineSegmentAt(i).EndPoint, pointOnLine) < Functions.getDistance3D(polyline.GetLineSegmentAt(i).StartPoint, pointOnLine)) Then
                                    referenzAngle += Math.PI
                                End If
                                Return True
                            ' Prüfen ob der Punkt auf dem Bogen zwischen 2 Punkten liegt
                            ElseIf (polyline.GetArcSegmentAt(i).IsOn(pointOnLine)) Then
                                ' Bestimmen des Winkels
                                referenzAngle = Functions.getRichtungswinkel2D(polyline.GetArcSegmentAt(i).GetTangent(pointOnLine).Direction)
                                ' Evtl. Winkel um Pi erhöhen falls der ausgewählte Punkt näher zum Zentrum des Bogens liegt
                                If (Functions.getDistance2D(polyline.GetArcSegmentAt(i).Center, refObjectResult.PickedPoint) < Functions.getDistance2D(polyline.GetArcSegmentAt(i).Center, pointOnLine)) Then
                                    referenzAngle += Math.PI
                                End If
                                Return True
                            End If
                        Next
                    ' Wenn es eine alte 2D-Polyline ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Polyline2d"
                        Dim polyline2d As Polyline2d = entity
                        ' Den dichtesten Punkt der Polyline zum PickedPoint bestimmen
                        Dim pointOnLine As Point3d = polyline2d.GetClosestPointTo(refObjectResult.PickedPoint, True)
                        ' Die Stützpunkte der Polyline bestimmen
                        Dim pointCollection As New Point3dCollection
                        For Each obj As Object In polyline2d
                            pointCollection.Add(CType(trans.GetObject(obj, OpenMode.ForRead), Vertex2d).Position)
                        Next
                        ' Durchlaufen aller Linien die durch die Stützpunkte der Polyline gegeben sind (-1 falls nicht geschlossen)
                        For i As Long = 0 To pointCollection.Count - IIf(Not polyline2d.Closed, 1, 0)
                            ' Prüfen ob der Punkt auf der Linie ein Stützpunkt ist
                            If (pointOnLine.IsEqualTo(pointCollection(i)) Or pointOnLine.IsEqualTo(pointCollection((i + 1) Mod pointCollection.Count))) Then
                                editor.WriteMessage(ControlChars.CrLf & "Sie haben einen Stützpunkt der Polyline ausgewählt. Winkelbestimmung nicht eindeutig.")
                                ' Beenden der Funktion
                                Return False
                            End If
                            ' Prüfen ob beide Punkte identisch sind
                            If (pointCollection(i).IsEqualTo(pointCollection((i + 1) Mod pointCollection.Count))) Then
                                ' Nächster Durchlauf der Schleife
                                Continue For
                            End If
                            ' Prüfen ob der Punkt auf der Linie zwischen 2 Punkten liegt
                            If (New Line3d(pointCollection(i), pointCollection((i + 1) Mod pointCollection.Count)).IsOn(pointOnLine)) Then
                                ' Bestimmen des Winkels
                                referenzAngle = Functions.getRichtungswinkel2D(pointCollection(i), pointCollection(i + 1))
                                ' Evtl. Winkel um Pi erhöhen falls der Punkt auf der Linie näher am zweiten Punkt der Linie liegt
                                If (Functions.getDistance2D(pointCollection((i + 1) Mod pointCollection.Count), pointOnLine) < Functions.getDistance2D(pointCollection(i), pointOnLine)) Then
                                    referenzAngle += Math.PI
                                End If
                                Return True
                            End If
                        Next
                    ' Wenn es eine 3D-Polyline ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Polyline3d"
                        Dim polyline3d As Polyline3d = entity
                        ' Den dichtesten Punkt der Polyline zum PickedPoint bestimmen
                        Dim pointOnLine As Point3d = polyline3d.GetClosestPointTo(refObjectResult.PickedPoint, True)
                        ' Die Stützpunkte der Polyline bestimmen
                        Dim pointCollection As New Point3dCollection
                        For Each obj As Object In polyline3d
                            pointCollection.Add(CType(trans.GetObject(obj, OpenMode.ForRead), PolylineVertex3d).Position)
                        Next
                        ' Durchlaufen aller Linien die durch die Stützpunkte der Polyline gegeben sind (-1 falls nicht geschlossen)
                        For i As Long = 0 To pointCollection.Count - IIf(Not polyline3d.Closed, 1, 0)
                            ' Prüfen ob der Punkt auf der Linie ein Stützpunkt ist
                            If (pointOnLine.IsEqualTo(pointCollection(i)) Or pointOnLine.IsEqualTo(pointCollection((i + 1) Mod pointCollection.Count))) Then
                                editor.WriteMessage(ControlChars.CrLf & "Sie haben einen Stützpunkt der Polyline ausgewählt. Winkelbestimmung nicht eindeutig.")
                                ' Beenden der Funktion
                                Return False
                            End If
                            ' Prüfen ob beide Punkte identisch sind
                            If (pointCollection(i).IsEqualTo(pointCollection((i + 1) Mod pointCollection.Count))) Then
                                ' Nächster Durchlauf der Schleife
                                Continue For
                            End If
                           ' Prüfen ob der Punkt auf der Linie zwischen 2 Punkten liegt
                            If (New Line3d(pointCollection(i), pointCollection(i + 1)).IsOn(pointOnLine)) Then
                                ' Bestimmen des Winkels
                                referenzAngle = Functions.getRichtungswinkel2D(pointCollection(i), pointCollection((i + 1) Mod pointCollection.Count))
                                ' Evtl. Winkel um Pi erhöhen falls der Punkt auf der Linie näher am zweiten Punkt der Linie liegt
                                If (Functions.getDistance2D(pointCollection((i + 1) Mod pointCollection.Count), pointOnLine) < Functions.getDistance2D(pointCollection(i), pointOnLine)) Then
                                    referenzAngle += Math.PI
                                End If
                                Return True
                            End If
                        Next
                    ' Wenn es ein Bogen ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Arc"
                        Dim arc As Arc = entity
                        ' Den dichtesten Punkt des Bogens zum PickedPoint bestimmen
                        Dim pointOnArc As Point3d = arc.GetClosestPointTo(refObjectResult.PickedPoint, True)
                        ' Anlegen eines 3D-Kreisbogens um die Tangente in dem Punkt zu bestimmen
                        Dim circularArc3D As New CircularArc3d(arc.Center, arc.Normal, arc.Radius)
                         ' Bestimmen des Winkels
                        referenzAngle = Functions.getRichtungswinkel2D(circularArc3D.GetTangent(pointOnArc).Direction)
                        ' Evtl. Winkel um Pi erhöhen falls der gewählte Punkt näher zum Zentrum des Bogens liegt
                        If (Functions.getDistance2D(arc.Center, refObjectResult.PickedPoint) < Functions.getDistance2D(arc.Center, pointOnArc)) Then
                            referenzAngle += Math.PI
                        End If
                        Return True
                    ' Wenn es ein Kreis ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Circle"
                        Dim circle As Circle = entity
                        ' Den dichtesten Punkt des Kreises zum PickedPoint bestimmen
                        Dim pointOnCircle As Point3d = circle.GetClosestPointTo(refObjectResult.PickedPoint, True)
                        ' Anlegen eines 3D-Kreisbogens um die Tangente in dem Punkt zu bestimmen
                        Dim circularArc3D As New CircularArc3d(circle.Center, circle.Normal, circle.Radius)
                         ' Bestimmen des Winkels
                        referenzAngle = Functions.getRichtungswinkel2D(circularArc3D.GetTangent(pointOnCircle).Direction)
                        ' Evtl. Winkel um Pi erhöhen falls der ausgewählte Punkt näher zum Zentrum des Kreises liegt
                        If (Functions.getDistance2D(circle.Center, refObjectResult.PickedPoint) < Functions.getDistance2D(circle.Center, pointOnCircle)) Then
                            referenzAngle += Math.PI
                        End If
                        Return True
                    ' Wenn es eine Ellipse ist
                    Case "Autodesk.AutoCAD.DatabaseServices.Ellipse"
                        Dim ellipse As Ellipse = entity
                        ' Den dichtesten Punkt der Ellipse zum PickedPoint bestimmen
                        Dim pointOnEllipse As Point3d = ellipse.GetClosestPointTo(refObjectResult.PickedPoint, True)
                        ' Einen zweiten, unweit entfernten Punkt auf der Ellipse bestimmen
                        Dim distanceAtPointOnEllipse As Double = ellipse.GetDistAtPoint(pointOnEllipse)
                        Dim secondPointOnEllipse As Point3d = ellipse.GetPointAtDist(distanceAtPointOnEllipse + ellipse.MinorRadius / 1000)
                        ' Bestimmen des Winkels
                        referenzAngle = Functions.getRichtungswinkel2D(pointOnEllipse, secondPointOnEllipse)
                        ' Evtl. Winkel um Pi erhöhen falls der ausgewählte Punkt näher zum Zentrum der Ellipse liegt
                        If (Functions.getDistance2D(ellipse.Center, refObjectResult.PickedPoint) < Functions.getDistance2D(ellipse.Center, pointOnEllipse)) Then
                            referenzAngle += Math.PI
                        End If
                        Return True
                    ' Ansonsten
                    Case Else
                        editor.WriteMessage(ControlChars.CrLf & "Für den Objekttyp '" & entity.GetType().Name & "' kann momentan noch kein Winkel exportiert werden. Bislang werden nur Blöcke, (K-)Linien, (M-,X-)Texte, Schraffuren, (2D-,3D-,LW-)Polylinien, Bögen, Kreise und Ellipsen unterstützt")
                        ' Beenden der Funktion
                        Return False
                End Select

            ' Abfangen eines evtl. auftretenden Fehlers
            Catch ex As System.Exception
                editor.WriteMessage(ControlChars.CrLf & "Fehler beim Extrahieren des Referenzwinkels" & ControlChars.CrLf & ex.Message & ControlChars.CrLf & "Funktion: getAngleFromObject(ByRef referenzAngle As Double, ByVal refObjectResult As PromptEntityResult) As Boolean")

            ' Schließen der Transaktion mit der Datenbank
            Finally
                trans.Dispose()
            End Try

        End Function

    End Module
End Namespace

---

[Diese Nachricht wurde von Gloem am 17. Dez. 2009 editiert.]

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

---

Hi,

>> leider funktioniert es nicht korrekt wenn ein BKS eingestellt ist

Wo darf ich bei dem ausführlichen langen Code zu suchen beginnen? Leider fehlt die Angabe, bei welcher Konstellation Dir ein Problem unterkommt.

Weitere Rückfrage: geht Dein Programm nur von einer 2D-Drehung aus oder soll dreidimensional ausgerichtet werden? Zeigst Du z.B. eine 3D-Polylinie, soll nur die WCS-XY-Drehung zwischen den Punkten als Basis dienen oder soll z.B. ein Text wirklich 3D an das Segment ausgerichtet werden?

Ich genehmige mir bei Funktionen, die über UCS Probleme bereiten i.d.R. ein temporäres setzen auf WCS, dann die Funktionen abhandeln und dann wieder zurücksetzen auf voriges UCS.

- alfred -

------------------
www.hollaus.at

---

Ich dachte mal einfach an dem Quellcode
könnte man das Problem am einfachsten nachverfolgen. Ich weiß leider nicht wo der Fehler auftaucht, beim extrahieren der Drehung von einem Objekt oder bei der Zuweisung dieser Drehung zu einem Text.

In dem Quellcode gibt es zwei Funktionen die eine Drehung aufgrund von zwei Punkten bzw. Eines Referenzobjektes bestimmen. Dieser Winkel wird nun den ausgewählten Texten zugewiesen.

Drehungen in 2D reichen vollkommen aus, da zumeist im Weltkoordinatensystem gearbeitet wird oder ein neues UCS durch Drehung um die z-Achse erstellt wird

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

---

Hi,

>> Ich dachte mal einfach an dem Quellcode könnte man das Problem
>> am einfachsten nachverfolgen. Ich weiß leider nicht wo der Fehler auftaucht

Bitte nicht falsch verstehen, der Quellcode scheint komplett und damit die beste Basis für Unterstützung! 
Nur möchte ich jetzt nicht alle möglichen Wege durchverfolgen und nachrechnen, wann der Fehler auftritt. Damit würde ich als Info gerne haben, dass Du mir zumindest einen Weg zeigst (z.B. Winkel über 2 Punkte zeigen und dann einen Text wählen), bei dem feststeht, dass das Problem auftritt.

Daher hab ich jetzt mal nicht probiert, nur gelesen und dabei wäre mir aufgefallen:

editor.GetPoint ist beim Überfliegen Deines Codes das einzige von UCS abhängige. Hast Du ein UCS, das um 50g verdreht ist, zeigst 2 Punkte 0,0 und 10,0, dann wird die Winkelfunktion 0 retournieren, während Du PI/4 erwartest.
Das kann ich aber aus Deinem Code nicht beurteilen, da ich nicht über die Funktion 'getRichtungswinkel2D' verfüge.

Damit stehen 2 Möglichkeiten zur Auswahl:

a) Du rechnest die Ergebnisse, die Du aus Editor.getPoint erhältst von UCS auf WCS um
Beispiel:

Code:

---

Dim tMat As Geometry.Matrix3d = myEditor.CurrentUserCoordinateSystem
Dim tWcsPoint as Geometry.Points3D = UcsPoint.TransformBy(tMat)

---

b) Du stellst vor der übergeordneten Funktion das UCS auf WCS um und stellst es nach Ablauf wieder zurück.

Die Rotation-Eigenschaft der Geometrieelemente ist immer (imho) auf WCS bezogen, unabhängig von VIEWTWIST, ANGDIR, ANGBASE.

HTH, - alfred -

------------------
www.hollaus.at

---

Sorry das ich erst jetzt schreibe aber Arbeit, Weihnachtsfeier, Tannenbaumkaufen, ...

Wie ich gerade bemerkt habe tritt der Fehler nicht nur bei Winkelbestimmung durch 2 Punkte auf sondern bspw. auch wenn ich eine Polyline als Refernzobjekt verwende und mir die Stützpunkte daraus extrahieren lasse. Müssen diese ggf. genau wie die Punkte per Editor transformiert werden?

Kann ich irgendwie abfragen ob ein Benutzerkoordinatensystem verwendet wird? Reicht es nur das Koordinatensystem umzustellen und die Ansicht so zu belassen?

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

---

Hi,

Eine LW-Poly führt intern die Koordinaten in einem Objektkoordinatensystem, diese müsste man schon umrechnen. Ich arbeite in diesem Fall aber immer mit folgender Funktion:

Code:

---

if trycast(tEnt,DatabaseServices.Curve) isNot Nothing) then
  Dim tPntColl As Geometry.Point3dCollection = New Geometry.Point3dCollection
  Call ctype(tent,DatabaseServices.Curve).GetStretchPoints(tPntColl)
  '....

---

In diesem Fall kannst Du Splines bis Linien auf ein Curve-Objekt casten und diese damit retournierten Punkte sind immer im WCS.

- alfred -

------------------
www.hollaus.at

---

Ich musste leider feststellen das der Rotationswinkel sich bei einem MText je nach BKS ändert, wohingegen er bei einem Text konstant ist.

Gibt es einen schlaueren Weg den Winkel im Weltkoordinatensystem rauszubekommen als den MText zu sprengen und den Winkel des Textes abzufragen?

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

---

Hi,

ich hab jetzt nicht alle Zustände probiert, vielleicht hilft es Dir:

Code:

---

Dim tSel As EditorInput.PromptEntityResult = tAcadDoc.Editor.GetEntity("MText: ")
If (tSel IsNot Nothing) AndAlso (tSel.Status = EditorInput.PromptStatus.OK) Then
  Dim tEnt As Entity = CType(tTrAct.GetObject(tSel.ObjectId, OpenMode.ForRead, False, True), Entity)
  If tEnt.GetType.Equals(GetType(DatabaseServices.MText)) Then
      Dim tMText As DatabaseServices.MText = CType(tEnt, DatabaseServices.MText)
      Dim tAng As Double = tMText.Direction.AngleOnPlane(New Geometry.Plane)
      tAcadDoc.Editor.WriteMessage((tAng * 180 / Math.PI).ToString)
  End If
End If

---

- alfred -

------------------
www.hollaus.at

---

Cool, danke das funktioniert. Somit funktioniert mein Progrämmchen nun wie es soll.

Das Problem mit meinen Polylinien konnte ich auch lösen. Die Objekte haben dieselbe Koordinate egal ob irgendein BKS oder das Weltkoordinatensystem. Ich hab nur immer anhand des PickedPoints geprüft auch welcher Seite einer Linie der Anwender das Objekt ausgewählt hat und dieser Punkt musste natürlich transformiert werden.

Zwei kleine Fragen hätte ich aber noch:
1) Gibt es Möglichkeit zu überprüfen ob der Anwender gerade im WCS oder in einem BKS ist? Irgendeine Boolsche Variable?
2) Was bewirkt das call bei "Call ctype(...)"

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

---

Hi,

>> ...das funktioniert

Danke für die Rückmeldung. 

>> zu überprüfen ob der Anwender gerade im WCS oder in einem BKS ist?
>> Irgendeine Boolsche Variable?

Hi, eine boolsche Information dazu wäre mir nicht bekannt,
entweder die Richtungen vergleichen oder die Systemvariable 'WORLDUCS' auf 1 prüfen. 

>> Was bewirkt das call bei "Call

In dotNET hat es keine Auswirkung (verinnerlichtes Relikt aus der Vergangenheit  )

- alfred -

------------------
www.hollaus.at