Solved! Go to Solution.
Solved by Alfred.NESWADBA. Go to Solution.
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 -
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 -
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 -
Hi,
can you reproduce that with a specific drawing? If so:
- alfred -
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.
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 -
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
Hi,
>> i am not able to add reference of Interop.Common.AcadEntity
goto add references ==> tab "COM" ==> search for
add them both.
- alfred -
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 -