Autocad Text Class
There are two text objects, plain old single line TEXT and new fancy multi-line MTEXT. By new I mean Rel 13 which was in 1994. Not that new.
Simple TEXT is created with AddText and MTEXT with AddMText both of which are methods of ModelSpace.
Simple TEXT uses a variable type ACADTEXT and MTEXT uses ACADMTEXT.
Links to autocad’s oddly hard to find help pages. Hold down your CTRL key when you click them so they load in a new tab. ActiveX is the key search term. Developers Guide and Reference Guide are the key clicks. The Object Model diagram with clickable labels is very useful. The methods to create an object are almost all a method of modelspace. Click on modelspace in the Object Model diagram to see its methods, such as AddText. Later click on the TEXT object itself to see its properties and methods, i.e. what you can change about it after it is created.
So you get to Modelspace Collection (ActiveX) and you find a list of ADD methods one of which is AddText. Then you have the syntax and sample code in VBA and Lisp
Now you have the method to create, return to the object model diagram and click on TEXT to see what you can do with a TEXT object.
The list of methods and properties, of an existing text object, that autocad shows on its help page, is the same list that VBA shows in the auto list members popup box (also called intellisense) that shows the available methods and properties to an object.
The autocad properties window has almost the same list of TEXT properties, but not the methods.
I thought I had code problems, but autocad text alignment is bizarre. Any attempt to change text alignment was bouncing the whole string down to 0,0. Notice in the help (link below) the phrase, will reset to 0,0,0. Yeah thats right. Here is where the help example helps. It works fine. Why does theirs work and not mine? There is a second variable to set other than Alignment. A bit more of a flagged warning would save time. I dont think its quite like they say. The point is not changed, you can read it, its 0,0,0, but you cannot write to it until the alignment is changed, then its default of 0,0 is used immediately as the insertion point – the text is moved to a random point of 0,0,0 – you can see it by stepping thru the help example. The text location then must be returned to its intended position by setting TextAlignmentPoint to the original insertionpoint. This is very curious.
Text is inserted at pt1 with insertion point at default lower left. Alignment is changed to lower right. The textalignment point now comes in to play, it is placed at the lower right of the text, and the text is moved so that lower right is at 0,0. Insertionpoint value is changed so it is at lower left. User runs code to set textalignment to pt1. Changing alignment changes insertionpoint by a random vector depending on how far the insertionpoint is from the origin. I dont think that will ever make sense. Clearly calculating the other end of the line is very complicated. It is as if they moved it to 0,0 to measure it. Insertionpoint is always lower left. In the properties window they call it Geometry Position X, Y, Z.
Here is the text wrapper with two global variables. Height is optional in the sub. If height is missing, then the global TextHeight is used. If TextHeight has not been set, then it is set to 1/8. This takes care of conventional (not class based) TEXT.
The text object g_txt is global so all the various properties can be set in the calling program.
Public TextHeight As Double Public g_txt As AcadText Sub txt1(str As String, ptx() As Double, Optional height As Variant) If TextHeight = 0 Then TextHeight = 0.125 If IsMissing(height) Then height = TextHeight End If Set g_txt = acadDoc.ModelSpace.AddText(str, ptx, height) g_txt.Layer = "0" End Sub Sub test1() ‘Demo create and modify text Dim str As String Call Connect_Acad Call insert_delete ‘cheapest low tech way to import layers, styles etc. TextHeight = 0.125 pt1 = pt(3, 2, 0) str = "some text here" txt1 str, pt1 g_txt.Layer = "bold" g_txt.StyleName = "ArialN" g_txt.textString = "change this text" g_txt.Alignment = acAlignmentBottomRight g_txt.Update 'text is now with lower right at origin 'insertionpoint is at lower left MsgBox g_txt.insertionPoint(0) & " , " & g_txt.insertionPoint(1) 'move text back so lower right is original insertionpoint g_txt.TextAlignmentPoint = pt1 'insertionpoint is still lower left MsgBox g_txt.insertionPoint(0) & " , " & g_txt.insertionPoint(1) g_txt.Update 'all these and more are available 'g_txt.Alignment 'g_txt.GetBoundingBox 'g_txt.Delete 'g_txt.height 'g_txt.InsertionPoint 'g_txt.IntersectWith 'g_txt.Layer 'g_txt.Move 'g_txt.ObjectID 'g_txt.ObjectName 'g_txt.ObliqueAngle 'g_txt.Rotate 'g_txt.Rotation 'g_txt.ScaleEntity 'g_txt.ScaleFactor 'g_txt.StyleName 'g_txt.TextAlignmentPoint 'g_txt.TextString End Sub
Now lets work on a Class implementation of the same thing.
Insert a Class Module.
Rename it to clsText.
You now have a blank module identical to a standard Module except there is more of an emphasis on module level variables, which are the properties of your Text object. Variables can be public or private. Public variables are simple and straightforward. Private variables require procedures to set and retrieve them called Let and Get. (Set is used for object variables.) Public variables require simple meaningful names. You can get started just by using the list of VBA properties of Text objects.
Start with the minimum requirement to make Text,
Modelspace.Addtext (string, insertpoint, height)
Public textString as string
Public height as double
Insertpoint is an array of 3 doubles. As soon as you try to make that a public variable and compile the module, VBA gives an error and informs you
‘Constants, fixed-length strings, arrays, user-defined types and Declare
‘statements not allowed as Public members of object modules
Private m_insertpt() as double
The m prefix stands for module, to me. Private variables are accessed thru public procedures. The name of the procedure is what shows in the calling program and the procedure and the variable cannot have the same ambiguous name to the compiler. So the procedure gets the simple meaningful name when the variable is private. The calling program does not know if the property is a public variable or a public procedure calling a private variable.
When the variable is public, it is simply called as a property of the object variable. First the object must be created in the calling program, then the properties can be set.
Dim txt1 As New clsText
txt1.textString = “some text here”
txt1.height = 0.125
The simple way I am doing this, there is no actual connection between the object in VBA and the text object created in autocad. Once the text object is created in autocad, the class object in vba no longer has control of it. So the properties have to be set prior to creation and the current environment in autocad will determine style, layer, everything. However we will be able to set all that prior to creating the text.
Our goal is
Txt1.print2 Textstring, insertpoint, height
The only other thing we need to create Text is to be able to set the InsertPoint. Even though we dont need it, lets look at Let and Get for TextString because its a simpler case than setting it for a point array.
Change the variable to private.
Private m_textString As String
From the menu pulldown Insert Procedure. Type Textstring for name, check property box. VBA inserts two generic Property stubs, Get and Let.
Public Property Get TextString() As Variant
Public Property Let TextString(ByVal vNewValue As Variant)
Change the variable to string. Change the passed variable name to something you like.
Get is something like a function, it passes back the value. Get is reading the private variable and returning it. So it becomes
Public Property Get TextString() As String TextString = m_textString End Property
Let is more like a Sub with a passed argument. It is setting the private variable.
Public Property Let TextString(ByVal str As String) m_textString = str End Property
The calling program though doesnt look like a sub. Textstring is a property of the Text object.
txt1.TextString = “some text here”
The Property procedures control the values and can do more than just set them.
VBA would not allow us to make a point array public, so we need those property procedures. We could separate the xy and z values, but I have come to prefer always passing them together in a dynamic array.
Private m_insertpt() As Double
Dynamic arrays are always passed by reference, Get is passing back an array of doubles and Let is passing in an array. This is the same method and syntax I have used in standard modules.
Public Property Get insertPt() As Double() insertPt = m_insertpt End Property 'arrays are always passed by reference Public Property Let insertPt(ByRef ptx() As Double) m_insertpt = ptx End Property
Now we need the print method. I wanted to do Debug.print only Text.Print but print is a reserved word, so it has to be Print1, but that worked out because we can do different versions of Print.
I left textstring as private, though it doesnt need to be. The insertpoint has to be private, and height can be public. Height is a pretty generic name, I would not be too surprised if it conflicted with something at some time.
Sub print1() Dim acadtxt1 As AcadText Set acadtxt1 = acadDoc.ModelSpace.AddText(m_textString, m_insertpt, height) End Sub
We can also pass in the variables. We have to make choices how we want it to work. The passed in variables could update the class variables, or just bypass them.
Sub print2(str As String, ptx() As Double, height As Double) Dim acadtxt1 As AcadText Set acadtxt1 = acadDoc.ModelSpace.AddText(str, ptx, height) End Sub
Here is a print variation that only takes string as an argument, and increments the line down everytime it is run.
Sub print3(str As String) Dim linefactor As Double linefactor = 1.5 * height m_textString = str m_insertpt = pt(m_insertpt(0), m_insertpt(1) - linefactor, m_insertpt(2)) Dim acadtxt1 As AcadText Set acadtxt1 = acadDoc.ModelSpace.AddText(m_textString, m_insertpt, height) End Sub
We need a little textstyle control. Here is the minimum way with no error checking. Later we will create the style if it is not found.
Private m_styleName As String Public Property Get styleName() As String styleName = m_styleName End Property Public Property Let styleName(ByVal strstylename As String) acadDoc.SetVariable "TEXTSTYLE", strstylename m_styleName = strstylename End Property
Now finally, we can run a test sub and see autocad output.
Sub test3() Call Connect_Acad Call insert_delete Dim txt1 As New clsText txt1.TextString = "some text here" txt1.height = 0.125 txt1.insertPt = pt(4, 3, 0) txt1.print1 Dim str As String str = " different text" txt1.print2 str, pt(4, 2, 0), 0.25 txt1.insertPt = pt(8, 3, 0) txt1.height = 0.125 txt1.print3 "line 1" txt1.print3 "line 2" txt1.print3 "line 3" txt1.print3 "line 4" txt1.print3 "line 5" txt1.styleName = "Calibri" txt1.print3 "line 6" End Sub
We can take advantage of our text class module and add some textstyle creation help. The code is the same as it would be outside the class, I already had it, but this seems like a convenient place to put it. This is not finished bullet proof, I wanted to leave the textstyle property simple for a first go. So here is a newstyle method, not a property.
First the basic text style creation sub which is private. Given the proper data, it can create any style. I think it came more or less straight out of autocad vba help.
Private Sub new_textstyle(str_stylename As String, str_typeface As String) Dim Bold As Boolean, Italic As Boolean Dim lngchar As Long, lngpitch As Long lngchar = 0 lngpitch = 34 'i am sure this is not meaningless but this is typ(swiss 32 variable 2) Bold = False Italic = False Dim TextStyles As AcadTextStyles Dim curStyle As AcadTextStyle Dim newstyle As AcadTextStyle Set curStyle = acadDoc.ActiveTextStyle Set TextStyles = acadDoc.TextStyles Set newstyle = TextStyles.Add(str_stylename) acadDoc.ActiveTextStyle = newstyle 'new style is added with no font information 'autocad assigns defaults similar or same as standard newstyle.SetFont str_typeface, Bold, Italic, lngchar, lngpitch acadDoc.ActiveTextStyle = newstyle End Sub
Now the public interface. It will be called like this. It maintains a list of favorites. Its simple, not slick.
Sub newstyle(strstylename As String) On Error Resume Next acadDoc.SetVariable "TEXTSTYLE", strstylename If Err Then Select Case strstylename Case "Arial" new_textstyle "Arial", "Arial" Case "ArialN" new_textstyle "Arial_N", "Arial Narrow" Case "Calibri" new_textstyle "Calibri", "Calibri" Case "Cambria" new_textstyle "Cambria", "Cambria" Case "Helvetica" new_textstyle "Helvetica", "Swis721 BT" Case "Palatino" new_textstyle "Palatino", "Palatino Linotype" Case "Tahoma" new_textstyle "Tahoma", "Tahoma" Case "Verdana" new_textstyle "Verdana", "Verdana" Case "Math" new_textstyle "Symath_IV50", "Symath_IV50" Case Else MsgBox "Style value not in my list" Exit Sub End Select End If m_styleName = strstylename End Sub
The test sub –
Sub test4() Call Connect_Acad Call insert_delete Dim txt1 As New clsText txt1.height = 0.125 txt1.insertPt = pt(4, 3, 0) Dim str As String str = " AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" txt1.newstyle "Arial" txt1.print3 "Arial" & str txt1.newstyle "ArialN" txt1.print3 "ArialN" & str txt1.newstyle "Calibri" txt1.print3 "Calibri" & str txt1.newstyle "Cambria" txt1.print3 "Cambria" & str ' actually Swis721 BT txt1.newstyle "Helvetica" txt1.print3 "Helvetica" & str txt1.newstyle "Palatino" txt1.print3 "Palatino" & str txt1.newstyle "Tahoma" txt1.print3 "Tahoma" & str txt1.newstyle "Verdana" txt1.print3 "Verdana" & str txt1.newstyle "Math" txt1.print3 str End Sub
And the output – generated with Text Class methods