---

Ist es euch eigentlich auch schon aufgefallen das GetBoundingBox bei Texten die mit TTF-Schriftarten und einem Weitenfaktor <> 1 geschrieben wurden, falsche Werte liefert?
Der MaxPoint wird anscheinend um den Faktor der Weite verschoben.
Ist das nur bei mir so, oder liegt das an ACAD2002.

------------------
Roland

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

---

Hallo Roland,

benutze diese Methode zwar nur aus LISP heraus, habe diese Erfahrung allerdings noch nicht gemacht, in keiner A2kX Version.

Grüße Holger

------------------
Holger Brischke
(defun - Lisp over night!
AutoLISP-Programmierung für AutoCAD
Da weiß man, wann man's hat!

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

---

Könnt ihr das einmal ausprobieren.

Code:

---

Public Sub Textmarker()
    Dim SS As AcadSelectionSet
    Dim FltTypesT(0) As Integer
    Dim FltDataT(0) As Variant
    Dim obj As AcadEntity
    Dim objText As AcadText
    Dim objTemp As AcadText
    Dim Shadow As AcadSolid
   
    Set SS = CreateSelectionSet("TextCalculateAuswahl")

    FltTypesT(0) = 0: FltDataT(0) = "TEXT"
   
    ' Selectionset erstellen, Benutzer fragen und Filter anwenden
    SS.SelectOnScreen FltTypesT, FltDataT
   
    If SS.Count = 0 Then GoTo Exit_Here
   
    For Each obj In SS
        If Not TypeOf obj Is AcadText Then GoTo NEXT_OBJ
        Set objText = obj
        Set objTemp = objText.Copy
       
        Dim min, max
        Select Case objText.Alignment
            Case 3, 5
                objTemp.TextAlignmentPoint = Point3D(objTemp.insertionPoint(0) + funDist(objTemp.insertionPoint, objTemp.TextAlignmentPoint), CDbl(objTemp.insertionPoint(1)), CDbl(objTemp.TextAlignmentPoint(2)))
            Case Else
                objTemp.Rotation = 0
        End Select
        objTemp.GetBoundingBox min, max
       
        Set Shadow = SolidBoundingBox(min, max, objText.height * 0.2)
       
        Select Case objText.Alignment
            Case 0
                Shadow.Rotate objTemp.insertionPoint, objText.Rotation
            Case 3, 5
                Shadow.Rotate objTemp.insertionPoint, ThisDrawing.Utility.AngleFromXAxis(objText.insertionPoint, objText.TextAlignmentPoint)
            Case Else
                Shadow.Rotate objTemp.TextAlignmentPoint, objText.Rotation
        End Select
        objTemp.Delete

NEXT_OBJ:
    Next obj
   

    Set obj = Nothing
    Set objTemp = Nothing
    Set Shadow = Nothing
    Set objText = Nothing
   
Exit_Here:
    SS.Delete
End Sub

Public Function SolidBoundingBox(Point1, Point2, Optional Dist As Double = 0) As AcadSolid
    Dim objSolid As AcadSolid
    Dim Pt1, Pt2, Pt3, Pt4 As Variant
   
    Pt1 = Point3D(CDbl(Point1(0)) - Dist, CDbl(Point1(1)) - Dist)
    Pt2 = Point3D(CDbl(Point2(0)) + Dist, CDbl(Point1(1)) - Dist)
    Pt3 = Point3D(CDbl(Point1(0)) - Dist, CDbl(Point2(1)) + Dist)
    Pt4 = Point3D(CDbl(Point2(0)) + Dist, CDbl(Point2(1)) + Dist)
   
   
    Set objSolid = ThisDrawing.CurrentSpace.AddSolid(Pt1, Pt2, Pt3, Pt4)
    Set SolidBoundingBox = objSolid

End Function

---

und unter ThisDrawing

Code:

---

Public Property Get CurrentSpace() As AcadBlock
    If Me.ActiveSpace = acModelSpace Then
        Set CurrentSpace = Me.ModelSpace
    Else
        If Me.MSpace Then
            Set CurrentSpace = Me.ModelSpace
        Else
            Set CurrentSpace = Me.ActiveLayout.Block
        End If
    End If
End Property

---

------------------
Roland

[Diese Nachricht wurde von RoSiNiNo am 01. Dez. 2003 editiert.]

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