Graphical entities in autocad vba are added with the add### methods which are members of AcadModelSpace, AcadPaperSpace, and AcadBlock.
The object browser shows AcadModelSpace has two members (actually has about 75 add-somethings)
Addtext(string, insertpt, height as double).
AddMText(insertpt, width as double, string)
Simple text is the old style and MText is the new full featured object. The insertion pt is the familiar array of 3 doubles. MText width refers to the box the entire text is within.
To place these in ModelSpace, we establish a link to the current document
which gives us the global Acaddoc which is
In the Object Browser, find AcadModelSpace, then right click on its members AddText and AddMText, choose Help, and you get the autocad help with code example with the very least steps to create a text object.
you must declare the correct object, set up the variables, and add text.
Dim textObj As AcadText
Dim MTextObj As AcadMText
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner, width, text)
in our case since we are running code from excel not inside autocad
Set textObj = AcadDoc.ModelSpace.AddText(textString, insertionPoint, height)
Set MTextObj = AcadDoc.ModelSpace.AddMText(corner, width, text)
The text will come in with the current style. The insert pt for text is lower left ( look up the justify option in the text command and the TextJustify readonly variable if you want to change that). The corner variable in the Mtext argument list is the top left corner of the box. It is the std 3 pt variable array of doubles.
For our application – we are going to add an option to label the graph with the equation. We dont want to add similar code to all our concise routines, but the only place to create a string showing the equation being graphed is in the equation sub. We will create a global string variable and when the equation runs we will fill the variable. The variable will still be available as long as the form is open. The user if he wishes can add the label with a button after the graph is made. To get the text location, we will use the bounding property of a block. our block is the axis. our test wont be too sophisticated – we will take the first block we find that has an insertion point at 0,0. We will use the 4 corners of the axis bounding box as a demonstration at this time, placing plain text and mtext. We will be interested in MText as it will have more options to format our equation, though the vba string variable may be a limitation.
We will create some public variables to hold the text locations and height, and a global pt0 at the origin so we dont have to set up when needed.
Public pt_LL(0 To 2) As Double Public pt_LR(0 To 2) As Double Public pt_UR(0 To 2) As Double Public pt_UL(0 To 2) As Double Public pt0(0 To 2) As Double Public label_height As Double Sub set_pt0() 'public variable pt0 is always the origin pt0(0) = 0: pt0(1) = 0: pt0(2) = 0 End Sub Sub bigger_label() label_height = label_height * 1.25 Call label_graph End Sub Sub smaller_label() label_height = label_height * 0.75 Call label_graph End Sub Sub label_graph() 'example program to place equation labels at the four corners of the graph 'uses text and mtext Dim i As Integer Dim s_set As AcadSelectionSet If strLabel "" Then 'fine Else MsgBox "strlabel not initialized" Exit Sub End If 'sets the four axis boundary pts to use as text inserts Call get_axis_extents If pt_LL(0) = 0 Then MsgBox "did not find an axis" Exit Sub End If If label_height = 0 Then label_height = 0.5 End If On Error Resume Next Set s_set = acadDoc.SelectionSets.Item("graph_labels") Debug.Print "s_set.count = " & s_set.Count 'if an autocad entity is in s_set but erased thru gui then s_set.erase restores entity 'paradoxically, 'the fix is to iterate through the set with error reporting off i = s_set.Count Do While i > 0 i = i - 1 'because ss index is zero based s_set.Item(i).Erase Loop Update On Error GoTo 0 Call add_ss("graph_labels") Set s_set = acadDoc.SelectionSets.Item("graph_labels") Dim textObj1 As AcadText, textObj2 As AcadText Set textObj1 = acadDoc.ModelSpace.AddText(strLabel, pt_LL, label_height) s_set.Select acSelectionSetLast Set textObj2 = acadDoc.ModelSpace.AddText(strLabel, pt_LR, label_height) s_set.Select acSelectionSetLast textObj2.Alignment = acAlignmentBottomRight textObj2.TextAlignmentPoint = pt_LR Dim MTextObj1 As AcadMText, MTextObj2 As AcadMText Dim width As Double width = 20 * label_height Set MTextObj1 = acadDoc.ModelSpace.AddMText(pt_UL, width, strLabel) s_set.Select acSelectionSetLast Set MTextObj2 = acadDoc.ModelSpace.AddMText(pt_UR, width, strLabel) s_set.Select acSelectionSetLast MTextObj1.height = label_height MTextObj2.height = label_height MTextObj2.AttachmentPoint = acAttachmentPointTopRight MTextObj2.insertionPoint = pt_UR Update End Sub Sub get_axis_extents() Dim blockRef As AcadBlockReference Dim entity As AcadEntity 'the only purpose is to retrieve a block reference inserted at 0,0 'then retrieve its bounding box 'and set global point variables to the 4 corners 'zoom to bounds 'use this as a test if a block was found and the point set pt_LL(0) = 0 For Each entity In acadDoc.ModelSpace If TypeOf entity Is AcadBlockReference Then Set blockRef = entity If blockRef.insertionPoint(0) = 0 And _ blockRef.insertionPoint(1) = 0 Then Exit For Else Set blockRef = Nothing End If End If Next If Not blockRef Is Nothing Then Debug.Print blockRef.Name Dim minExt As Variant, maxExt As Variant blockRef.GetBoundingBox minExt, maxExt Debug.Print minExt(0) & ", " & minExt(1) & ", " & minExt(2) Debug.Print maxExt(0) & ", " & maxExt(1) & ", " & maxExt(2) pt_LL(0) = minExt(0): pt_LL(1) = minExt(1): pt_LL(2) = 0 pt_LR(0) = maxExt(0): pt_LR(1) = minExt(1): pt_LR(2) = 0 pt_UR(0) = maxExt(0): pt_UR(1) = maxExt(1): pt_UR(2) = 0 pt_UL(0) = minExt(0): pt_UL(1) = maxExt(1): pt_UL(2) = 0 acadApp.ZoomWindow minExt, maxExt acadApp.ZoomScaled 0.9, acZoomScaledRelative Update End If