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