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 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 _ 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, "") ' 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