Topic: Mtext field

[devarino]

Need a little assistance. I want to be able to add the textheight and stylename to the below code when adding the Mtext.

Code - Auto/Visual Lisp: [Select]

1. (setq Obj (vlax-ename->vla-object (entlast)))
2. (vla-put-height Obj 12)
3. (vla-put-stylename Obj "ARIAL")
4.  
5.  
6.  
7.  
8. ;;; AreaText.LSP ver 4.0
9. ;;; Command names are AT, ATC, ATM
10. ;;; Sample result: 2888.89 SQ. FT.
11. ;;; As this is a FIELD it is updated based on the FIELDEVAL
12. ;;; or the settings found in the OPTIONS dialog box
13.  
14. ;;; By Jimmy Bergmark
15. ;;; Copyright (C) 2007-2018 JTB World, All Rights Reserved
16. ;;; Website: https://jtbworld.com
17. ;;; E-mail: info@jtbworld.com
18. ;;; 2007-09-05 - First release
19. ;;; 2009-08-02 - Updated to work in both modelspace and paperspace
20. ;;; 2010-10-29 - Updated to work also on 64-bit AutoCAD
21. ;;; 2018-11-11 - Added command ATC to add the text at the geo center on selected object
22. ;;;              Added command ATM to add the text at the bounding box center on selected objects
23.  (setq jtbfieldformula ">%).Area \\f \"%lu2%pr2%ps[, ACRES]%ct8[2.295684113865926E-005]>%")
24. ;;; Uses TEXTSIZE for the text height
25. (defun c:ACRES (/ entObject entObjectID InsertionPoint ad)
26.   (vl-load-com)
27.   (setq entObject      (vlax-ename->vla-object (car (entsel)))
28.         entObjectID    (Get-ObjectIDx64 entObject)
29.         InsertionPoint (vlax-3D-Point (getpoint "Select point: "))
30.         ad             (vla-get-ActiveDocument (vlax-get-acad-object))
31.   )
32.   (vla-addMText
33.     (if (= 1 (vla-get-activespace ad))
34.       (vla-get-modelspace ad)
35.       (if (= (vla-get-mspace ad) :vlax-true)
36.         (vla-get-modelspace ad)
37.         (vla-get-paperspace ad)
38.       )
39.     )
40.     InsertionPoint
41.     0.0
42.     (strcat
43.       "%<\\AcObjProp Object(%<\\_ObjId "
44.       entObjectID
45.       jtbfieldformula
46.     )
47.   )
48. )
49. )

EDIT (John): Added code tags.

[tombu]

Why not just use Lee Mac's Areas to Field? http://www.lee-mac.com/areastofield.html
using his Field Formatting Code to put the " SQ. FT" on the end if need be. http://www.lee-mac.com/fieldformat.html

[devarino]

Ok, Works good. I have the output as Acres as expected. But, how do I get it to be hard coded for the stylename and text height etc...?

Code - Auto/Visual Lisp: [Select]

1. ;;------------------------=={ Areas to Field }==------------------------;;
2. ;;                                                                      ;;
3. ;;  This program allows a user to create an MText object containing a   ;;
4. ;;  Field Expression referencing the area, or sum of areas, of one or   ;;
5. ;;  more selected objects.                                              ;;
6. ;;                                                                      ;;
7. ;;  Upon issuing the command syntax 'A2F' at the AutoCAD command-line,  ;;
8. ;;  the user is prompted to make a selection of objects for which to    ;;
9. ;;  retrieve the area; if more than one object is selected, the         ;;
10. ;;  cumulative area for all objects will be displayed by the resultant  ;;
11. ;;  MText Field.                                                        ;;
12. ;;                                                                      ;;
13. ;;  Following object selection, the user is prompted to pick a point    ;;
14. ;;  at which to create the MText Field. If the specified point resides  ;;
15. ;;  within an AutoCAD table cell, the program will populate the table   ;;
16. ;;  cell with the appropriate Field Expression.                         ;;
17. ;;                                                                      ;;
18. ;;  The Field will display the sum of the areas of the selected         ;;
19. ;;  objects, formatted using the Field formatting code specified at     ;;
20. ;;  the top of the program - this formatting code may be altered to     ;;
21. ;;  suit the user's requirements.                                       ;;
22. ;;                                                                      ;;
23. ;;----------------------------------------------------------------------;;
24. ;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
25. ;;----------------------------------------------------------------------;;
26. ;;  Version 1.3    -    2014-07-17                                      ;;
27. ;;----------------------------------------------------------------------;;
28.  
29. (defun c:a2f ( / *error* fmt inc ins lst sel str )
30.  
31.     (setq fmt "%lu2%pr2%ps[, ACRES]%ct8[2.295684113865926E-005]") ;; Field Formatting
32.  
33.     (defun *error* ( msg )
34.         (LM:endundo (LM:acdoc))
35.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
36.             (princ (strcat "\nError: " msg))
37.         )
38.         (princ)
39.     )
40.  
41.     (if (and (setq sel (ssget '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE"))))
42.              (setq ins (getpoint "\nPick point or cell for field: "))
43.         )
44.         (progn
45.             (if (setq tmp
46.                     (ssget "_X"
47.                         (list '(0 . "ACAD_TABLE")
48.                             (if (= 1 (getvar 'cvport))
49.                                 (cons 410 (getvar 'ctab))
50.                                '(410 . "Model")
51.                             )
52.                         )
53.                     )
54.                 )
55.                 (repeat (setq idx (sslength tmp))
56.                     (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
57.                 )
58.             )
59.             (if (= 1 (sslength sel))
60.                 (setq str
61.                     (strcat
62.                         "%<\\AcObjProp Object(%<\\_ObjId "
63.                         (LM:ObjectID (vlax-ename->vla-object (ssname sel 0)))
64.                         ">%).Area \\f \"" fmt "\">%"
65.                     )
66.                 )
67.                 (progn
68.                     (repeat (setq idx (sslength sel))
69.                         (setq lst
70.                             (vl-list*
71.                                 "%<\\AcObjProp Object(%<\\_ObjId "
72.                                 (LM:ObjectID (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
73.                                 ">%).Area>%" " + "
74.                                 lst
75.                             )
76.                         )
77.                     )
78.                     (setq str
79.                         (strcat
80.                             "%<\\AcExpr "
81.                             (apply 'strcat (reverse (cdr (reverse lst))))
82.                             " \\f \"" fmt "\">%"
83.                         )
84.                     )
85.                 )
86.             )
87.             (LM:startundo (LM:acdoc))
88.             (if (setq tmp (LM:getcell tab (trans ins 1 0)))
89.                 (apply 'vla-settext (append tmp (list str)))
90.                 (vla-addmtext
91.                     (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
92.                     (vlax-3D-point (trans ins 1 0))
93.                     0.0
94.                     str
95.                 )
96.             )
97.             (LM:endundo (LM:acdoc))
98.         )
99.     )
100.     (princ)
101. )
102.  
103. ;; ObjectID  -  Lee Mac
104. ;; Returns a string containing the ObjectID of a supplied VLA-Object
105. ;; Compatible with 32-bit & 64-bit systems
106.  
107. (defun LM:ObjectID ( obj )
108.     (eval
109.         (list 'defun 'LM:ObjectID '( obj )
110.             (if
111.                 (and
112.                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
113.                     (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
114.                 )
115.                 (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
116.                '(itoa (vla-get-objectid obj))
117.             )
118.         )
119.     )
120.     (LM:ObjectID obj)
121. )
122.  
123. ;; Get Cell  -  Lee Mac
124. ;; If the supplied point lies within a cell boundary,
125. ;; returns a list of: (<VLA Table Object> <Row> <Col>)
126.  
127. (defun LM:getcell ( lst pnt / dir )
128.     (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
129.           pnt (vlax-3D-point pnt)
130.     )
131.     (vl-some
132.        '(lambda ( tab / row col )
133.             (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
134.                 (list tab row col)
135.             )
136.         )
137.         lst
138.     )
139. )
140.  
141. ;; Start Undo  -  Lee Mac
142. ;; Opens an Undo Group.
143.  
144. (defun LM:startundo ( doc )
145.     (LM:endundo doc)
146.     (vla-startundomark doc)
147. )
148.  
149. ;; End Undo  -  Lee Mac
150. ;; Closes an Undo Group.
151.  
152. (defun LM:endundo ( doc )
153.     (while (= 8 (logand 8 (getvar 'undoctl)))
154.         (vla-endundomark doc)
155.     )
156. )
157.  
158. ;; Active Document  -  Lee Mac
159. ;; Returns the VLA Active Document Object
160.  
161. (defun LM:acdoc nil
162.     (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
163.     (LM:acdoc)
164. )
165.  
166. (vl-load-com) (princ)
167.  
168. ;;----------------------------------------------------------------------;;
169. ;;                             End of File                              ;;
170. ;;----------------------------------------------------------------------;;
171.  

EDIT (John): Added code tags.

[tombu]

It uses the current text height but setting the TEXTSIZE system variable is easy enough to code but odd unless you only use one Annotation Scale for all your drawings. It also uses the current Text Style and hard coding that would need to test if that Text Style was already in the drawing first, define it if necessary, and then setting it current.
 
As my drawings use different scales I need text height set to plot at 0.1" so I wrote this lisp to set size by picking text, entering a value, picking two points, or calculate it from CANNOSCALEVALUE if in Model Space.  It doesn't change on Escape.

Code: [Select]

;| Text size - This one you can get text size by picking text, entering a value, picking two points, or calculate it from CANNOSCALEVALUE if in Model Space. When it prompts with text size hit Enter to set it to that value or Escape if you don't want to change it.
   (load "TXTsize.LSP") tas ;
   by: Tom Beauford
   Leon County Public Works Engineering
===============================================|;
(defun C:tas (/ *error* vars tnt ts txt etp style)
  (setq vars (mapcar '(lambda (x) (cons x (getvar x))) '("luprec" "modemacro" "cmdecho")))
  (defun *error* (msg)
    ;; Reset variables
    (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars)
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (setvar "luprec" 8)
  (setvar "cmdecho" 0)
  (grtext -1 "Select Text, Mtext or Attribute. Enter for more Options.")
  (setq tnt(nentsel "\nSelect Text Entity: "))
  (cond
((= 1 (getvar "cvport"))(setq ts "0.1"))
((= 1 (getvar "TILEMODE"))(setq ts (rtos(/ 0.1 (getvar 'cannoscalevalue))2 3)))
(T(setq ts (rtos(/(caddr (trans '(0 0 1) 3 2))10)2 3)))
  )
  (if (= "0" (substr ts (strlen ts)))
    (while (= (atof ts)(atof (substr ts 1 (- (strlen ts)1))))
      (setq ts(substr ts 1 (- (strlen ts)1)))
    );while
  );if
  (setq txt (strcat"\nChange Text Size from " (rtos(getvar "textsize")) " to :<" ts "> "))
  (if tnt (setq etp (cdr(assoc 0 (entget(car tnt))))))
  (if (or(= "TEXT" etp)(= "MTEXT" etp)(= "ATTRIB" etp))
    (progn
      (setq style (getvar "textstyle")
            style (tblobjname "style" style)
            xdata (cadr (assoc -3 (entget style '("AcadAnnotative"))))
            tnt(cdr(assoc 40 (entget (car tnt))))
      );setq
      (if(and xdata (= (cdr (nth 4 xdata)) 1))
        (setq tnt(* tnt (getvar "cannoscalevalue")))
      );if
    );progn
    (progn
      (grtext -1 "Enter Size, Pick 2 Points or Accept Default.")
      (setq tnt (getdist txt))
    );progn
  );if
  (if (or(= tnt nil)(= tnt 0.0))
    (setq tnt (atof ts))
  );if
    (setvar "textsize" tnt)
  (setq tnt (rtos(getvar "textsize")))
  (if (= "0" (substr tnt (strlen tnt)))
    (while (= (atof tnt)(atof (substr tnt 1 (- (strlen tnt)1))))
      (setq tnt(substr tnt 1 (- (strlen tnt)1)))
    );while
  );if
  (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars)
  (grtext -1 "") ;Clear status line
  (vl-cmdf "redraw")
  (princ)
)


[Lee Mac]

Change:

Code - Auto/Visual Lisp: [Select]

1.             (if (setq tmp (LM:getcell tab (trans ins 1 0)))
2.                 (apply 'vla-settext (append tmp (list str)))
3.                 (vla-addmtext
4.                     (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
5.                     (vlax-3D-point (trans ins 1 0))
6.                     0.0
7.                     str
8.                 )
9.             )

To:

Code - Auto/Visual Lisp: [Select]

1.             (if (setq tmp (LM:getcell tab (trans ins 1 0)))
2.                 (apply 'vla-settext (append tmp (list str)))
3.                 (progn
4.                     (setq obj
5.                         (vla-addmtext
6.                             (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
7.                             (vlax-3D-point (trans ins 1 0))
8.                             0.0
9.                             str
10.                         )
11.                     )
12.                     (vla-put-height obj 2.5)
13.                     (vla-put-stylename obj "Standard")
14.                 )
15.             )

Text Style must exist in the drawing, otherwise you'll receive an error.

[V-Man]

@Lee Mac

Works perfectly. Many thanks for your input.

V-Man