GetBoundingBox error

[muthineni]

I have written the below code, Dim GE As Extents3d GE = Txt.GeometricExtents OldTxtWidth = GE.MaxPoint.X - GE.MinPoint.X But i am not getting the width of the text properly. In maxpoint i am always getting 0. Can anyone please help me out from this issue? Thank you.

[Alfred.NESWADBA]

Hi,

Textojects and Attributes makes me always thinking that I have to kick someone because of this problem 😉

For me I do first the normal GeometricExtents-handling and if there is Min- or MaxPoint as 0,0,0 I check it using the COM-way, e.g.:

ctype(myTextObj.AcadObject,Interop.Common.AcadText).GetBoundingBox(PntMin,PntMax)

But be careful ==> that only works if the Text- or AttRef-object is already in the database.

- alfred -

[muthineni]

I am new to Autocad Programming, Can you please explain me a bit elaborate on how to get the TextObject Width in vb.net

[Alfred.NESWADBA]

Hi,

>> Can you please explain me a bit elaborate on how to get the TextObject Width in vb.net

you showed the code-snippet already, what should I then describe?

Plus the additional codeline in case of 0,0,0-problem I gave you in my previous message.

Sorry, it seems that I don't understand something.

- alfred -

[muthineni]

i am extremely sorry i am not able to understand how to get the width of a textobject in general, not if 0 comes. In general can you please tell me the code of how to get the text object width using geometricextents in vb.net?

[Alfred.NESWADBA]

Hi,

look at this code, I wrote that sometimes to get a border around a textobject. That should help you to get the width of the text (rotated or not).

      Public Shared Function getStringBorder(ByRef TextObj As DatabaseServices.DBText) As DatabaseServices.Curve
         Dim tRetVal As DatabaseServices.Curve = Nothing
         Dim tWorkObj As DatabaseServices.DBText = TextObj
         Dim tWorkObjIsCloned As Boolean = False
         Try
            If (tWorkObj IsNot Nothing) AndAlso (tWorkObj.TextString.Trim.Length > 0) Then
               If Not tWorkObj.IsWriteEnabled Then
                  'kopieren, damit wir damit arbeiten koennen
                  tWorkObj = CType(tWorkObj.Clone, DatabaseServices.DBText)
                  tWorkObjIsCloned = True
               End If
               Dim tPrevRotation As Double = tWorkObj.Rotation
               If tPrevRotation <> 0 Then
                  'auf waagrecht drehen, sonst kommen wir mit den extents nie zurecht
                  tWorkObj.TransformBy(Geometry.Matrix3d.Rotation(-tPrevRotation, New Geometry.Vector3d(0, 0, 1), tWorkObj.Position))
               End If
               Dim tGeomExtents As DatabaseServices.Extents3d = tWorkObj.GeometricExtents     'damit haben wir jetzt die extents des waagrecht ausgerichteten objekts
               Dim tGeomWidth As Double = tGeomExtents.MaxPoint.X - tGeomExtents.MinPoint.X
               'jetzt muessen wir noch aufpassen, ob wir es hier mit einem map/civil2009-SP2 fehler handelt, da werden naemlich
               '  texte, die nicht linksbuendig sind, so gerechnet als waeren sie linksbuendig
               If (tWorkObj.HorizontalMode <> TextHorizontalMode.TextLeft) AndAlso (tWorkObj.Position.X = tWorkObj.AlignmentPoint.X) Then
                  Select Case tWorkObj.HorizontalMode
                     Case TextHorizontalMode.TextMid, TextHorizontalMode.TextCenter
                        tGeomExtents = New DatabaseServices.Extents3d(New Geometry.Point3d(tGeomExtents.MinPoint.X - tGeomWidth / 2.0, tGeomExtents.MinPoint.Y, tGeomExtents.MinPoint.Z), New Geometry.Point3d(tGeomExtents.MaxPoint.X - tGeomWidth / 2.0, tGeomExtents.MaxPoint.Y, tGeomExtents.MaxPoint.Z))
                     Case TextHorizontalMode.TextRight
                        tGeomExtents = New DatabaseServices.Extents3d(New Geometry.Point3d(tGeomExtents.MinPoint.X - tGeomWidth, tGeomExtents.MinPoint.Y, tGeomExtents.MinPoint.Z), New Geometry.Point3d(tGeomExtents.MaxPoint.X - tGeomWidth, tGeomExtents.MaxPoint.Y, tGeomExtents.MaxPoint.Z))
                     Case Else
                        'TODO
                        'die typen 'aligned' und 'fit' werden hier mal nicht getrennt ausgewertet
                  End Select
               End If
               Dim tCurve As DatabaseServices.Polyline = New DatabaseServices.Polyline()
               tCurve.AddVertexAt(0, New Geometry.Point2d(tGeomExtents.MinPoint.X, tGeomExtents.MinPoint.Y), 0, 0, 0)
               tCurve.AddVertexAt(1, New Geometry.Point2d(tGeomExtents.MaxPoint.X, tGeomExtents.MinPoint.Y), 0, 0, 0)
               tCurve.AddVertexAt(2, New Geometry.Point2d(tGeomExtents.MaxPoint.X, tGeomExtents.MaxPoint.Y), 0, 0, 0)
               tCurve.AddVertexAt(3, New Geometry.Point2d(tGeomExtents.MinPoint.X, tGeomExtents.MaxPoint.Y), 0, 0, 0)
               tCurve.Closed = True
               If tPrevRotation <> 0 Then
                  'polylinie zum text hindrehen, textobj zurueckdrehen
                  tCurve.TransformBy(Geometry.Matrix3d.Rotation(tPrevRotation, New Geometry.Vector3d(0, 0, 1), tWorkObj.Position))
                  tWorkObj.TransformBy(Geometry.Matrix3d.Rotation(tPrevRotation, New Geometry.Vector3d(0, 0, 1), tWorkObj.Position))
               End If
            End If
         Catch ex As Exception
            Call MsgBox("Error during calculation of TextBorder" & ex.Message)
         Finally
            If tWorkObjIsCloned Then tWorkObj.Dispose()
         End Try
         Return tRetVal
      End Function

 - alfred -

[muthineni]

same problem with the above code also, in the below line, Dim tGeomWidth As Double = tGeomExtents.MaxPoint.X - tGeomExtents.MinPoint.X Maxpoint.x is always coming as 0. Could anyone please help me out from this issue? Thank you.

[Alfred.NESWADBA]

Hi,

can you reproduce that with a specific drawing? If so:

• upload this drawing
• let us know your producttype (if it's a vertical product)
• let us know revision + servicepack

- alfred -

[muthineni]

Please find the attached drawing,

In that for eaxmple for cirlce 1 (1 written inside circle), 11440-15 B1 SW ,  should be changed to -T  and the circle should be deleted, so that the text should be moved left for that the new width should be known.

Can you please check whether the min and max points are coming correctly or not?

I am using visual studio 2008 and autocad 2007.

[Alfred.NESWADBA · Accepted solution]

Hi,

you speak German? ... just because of layernaming 😉

>> Can you please check whether the min and max points are coming correctly or not?

Well I don't have 2007 to test now (maybe at night), so at the moment I just have tips you can try:

You have some textstyles with "bigfont"-usage. Try to change them not to use this option, save the drawing (with another name) and try it once more.

With 2012 and bigfont switched off (as I don't have yours) I get Extents.MaxPoint.X <> 0 as a result using this checkcode:

   <Runtime.CommandMethod("ADESK_getMinMax")> _
   Public Shared Sub ADESK_getMinMax()
      Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
      Dim tTrAct As DatabaseServices.Transaction = Nothing
      Try
         tTrAct = tAcadDoc.TransactionManager.StartTransaction

         Dim tRes As EditorInput.PromptEntityResult = tAcadDoc.Editor.GetEntity("Select Entitiy: ")
         If (tRes IsNot Nothing) AndAlso (tRes.Status = EditorInput.PromptStatus.OK) AndAlso (tRes.ObjectId.IsValid) Then
            Dim tEnt As DatabaseServices.Entity = CType(tTrAct.GetObject(tRes.ObjectId, DatabaseServices.OpenMode.ForRead), DatabaseServices.Entity)

            'first test through direct access
            Dim tExtents As DatabaseServices.Extents3d = tEnt.GeometricExtents
            tAcadDoc.Editor.WriteMessage(vbNewLine & "DEFAULT: MinX: " & Format(tExtents.MinPoint.X, "#0.00") & " / MaxX: " & Format(tExtents.MaxPoint.X, "#0.00"))

            'second approach using COM 
            'you have to add the reference for that:
            '  Autodesk.AutoCAD.Interop.Command
            Dim tEntCOM As Interop.Common.AcadEntity = CType(tEnt.AcadObject, Interop.Common.AcadEntity)
            Dim tPntMin As Object
            Dim tPntMax As Object
            Call tEntCOM.GetBoundingBox(tPntMin, tPntMax)
            tAcadDoc.Editor.WriteMessage(vbNewLine & "COM:     MinX: " & Format(CType(tPntMin, Double())(0), "#0.00") & " / MaxX: " & Format(CType(tPntMax, Double())(0), "#0.00"))
         End If

      Catch ex As Exception
         MsgBox("Some exception occured" & vbNewLine & ex.Message)
      Finally
         If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
      End Try

   End Sub

Please find also in this code that I did check the extents twice, the first version is how I would do it for default, the second version is by using the COM-component (as I mentined earlier).

- alfred -

[muthineni]

First Approach i am getting same 0 value. Second approach i am not able to add reference of Interop.Common.AcadEntity . Not knowing where to find that reference. If it is possible could you please check with AutoCAD 2007. ' I am new to Autocad .NET, so please dont mind if i am asking simple questions like adding COM component. Thank you.

[Hallex]

Here is tested code for A2010

I haven't A2007 on my machine

so I can't test your solution

See if that helps

        <CommandMethod("DrawTextFrame", "tframe", CommandFlags.UsePickSet And CommandFlags.Redraw)> _
        Public Shared Sub DrawTextFrame()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim ed As Editor = doc.Editor
            Dim db As Database = doc.Database
            Try
                Using tr As Transaction = db.TransactionManager.StartTransaction

                    Dim peo As PromptEntityOptions = New PromptEntityOptions(vbCrLf + "select text")
                    peo.SetRejectMessage(vbCrLf + "selected object is not a text")
                    peo.AddAllowedClass(GetType(DBText), True)
                    Dim id As ObjectId = ed.GetEntity(peo).ObjectId
                    Dim txt As DBText = CType(tr.GetObject(id, OpenMode.ForWrite), DBText)

                    If txt Is Nothing Then
                        Return
                    End If
                    '' ---> next code block is completely borrowed from Kean Walmsley 
                    Dim pts As New Point3dCollection
                    ' We have a special approach for DBText and

                    ' AttributeReference objects, as we want to get

                    ' all four corners of the bounding box, even

                    ' when the text or the containing block reference

                    ' is rotated

                    If txt.Bounds.HasValue AndAlso txt.Visible Then

                        ' Create a straight version of the text object

                        ' and copy across all the relevant properties

                        ' (stopped copying AlignmentPoint, as it would

                        ' sometimes cause an eNotApplicable error)


                        ' We'll create the text at the WCS origin

                        ' with no rotation, so it's easier to use its

                        ' extents

                        Dim txt2 As New DBText()

                        txt2.Normal = Vector3d.ZAxis

                        txt2.Position = Point3d.Origin

                        ' Other properties are copied from the original

                        txt2.TextString = txt.TextString

                        '.TextStyle = txt.TextStyle '<--2009

                        txt2.TextStyleId = txt.TextStyleId '<--2010

                        txt2.LineWeight = txt.LineWeight

                        txt2.Thickness = txt2.Thickness

                        txt2.HorizontalMode = txt.HorizontalMode

                        txt2.VerticalMode = txt.VerticalMode

                        txt2.WidthFactor = txt.WidthFactor

                        txt2.Height = txt.Height

                        txt2.IsMirroredInX = txt2.IsMirroredInX

                        txt2.IsMirroredInY = txt2.IsMirroredInY

                        txt2.Oblique = txt.Oblique

                        ' Get its bounds if it has them defined

                        ' (which it should, as the original did)

                        If txt2.Bounds.HasValue Then

                            Dim maxPt As Point3d = txt2.Bounds.Value.MaxPoint

                            ' Place all four corners of the bounding box

                            ' in an array

                            Dim bounds As Point2d() = New Point2d() {Point2d.Origin, New Point2d(0.0, maxPt.Y), New Point2d(maxPt.X, maxPt.Y), New Point2d(maxPt.X, 0.0)}

                            ' We're going to get each point's WCS coordinates

                            ' using the plane the text is on

                            Dim pl As New Plane(txt.Position, txt.Normal)

                            ' Rotate each point and add its WCS location to the

                            ' collection

                            For Each pt As Point2d In bounds

                                pts.Add(pl.EvaluatePoint(pt.RotateBy(txt.Rotation, Point2d.Origin)))

                            Next
                            ''<--- end code block
                            Dim poly As New Polyline
                            For i As Integer = 0 To 3
                                poly.AddVertexAt(i, pts(i).Convert2d(pl), 0, 0, 0)
                            Next
                            poly.Closed = True
                            Dim mat As Matrix3d = Matrix3d.Displacement(Point3d.Origin.GetVectorTo(txt.Position))
                            poly.TransformBy(mat)

                            Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
                            btr.AppendEntity(poly)
                            tr.AddNewlyCreatedDBObject(poly, True)
                            txt2.Dispose()
                            tr.Commit()

                        End If
                    End If

                End Using
            Catch ex As System.Exception

                ed.WriteMessage("{0}" & vbLf & "{1}", ex.Message, ex.StackTrace)

            Finally

            End Try

        End Sub

[Alfred.NESWADBA]

Hi,

>> i am not able to add reference of Interop.Common.AcadEntity

goto add references ==> tab "COM" ==> search for

• AutoCAD 2007 Type Library
• AutoCAD/ObjectDBX Common  17.0 Type Library

add them both.

- alfred -

[muthineni]

Thank you so much for the help you are doing, values are coming correctly using COM approach. Is there any disadvantage if COM approach is used? Thank you.

[muthineni]

Thank you so much, now it is working fine. But if i add reference for AutoCAD 2007 Type Library AutoCAD/ObjectDBX Common 17.0 Type Library , the dll is working only for A2007, but my dll should work in all the versions from A2007. If i add refernce for A2010, it working for A2010 and not for A2007. How to make the dll work in all versions?

[Alfred.NESWADBA]

Hi,

>> Is there any disadvantage if COM approach is used?

This method can not be used while the textobject (or AttributeReference) is just created in memory and not already inserted into the database.

>> the dll is working only for A2007, but my dll should work in all the versions from A2007

That's why I always create different solutions (at least) for 2007 and 2010 and for 32bit and 64bit. You willl recognize that there are also changes to the signatures of the dotNET-API (not just the COM-API) that makes the source not compatible between release changes of AutoCAD.

E.g. look also to the code from Hallex a few messages upper to this:

 '.TextStyle = txt.TextStyle '<--2009
 txt2.TextStyleId = txt.TextStyleId '<--2010

He showed the change of how to set the TextStyle for an text-like object.

So make different VS-solutions where you can use the same source files, but different references and some very little different code-files just for handling the differences.

BTW: you did not set the flag "Copy local" for the references? This flag has to be set to NO!

- alfred -

[muthineni]

Thank you so much for the information. Any how the macro will be used at the end. Then i should create two solutions, one for A2007 and A2010.