Sum of attribute values

[M.Nagaty]

Hello,

I've got this lisp routine it works well but I want to modify the result to be in (Mtext) instead of (table) and sum all values in attribute as shown in attached example, Any help please ?

 

 

 

;;---------------------=={ Sum Attribute Values }==---------------------;;
;; ;;
;; This program allows the user to sum numerical attribute values ;;
;; held by a selection of block references, with the results displayed ;;
;; in an AutoCAD table. ;;
;; ;;
;; Upon issuing the command syntax 'attsum' at the AutoCAD ;;
;; command-line, the user is first prompted to make a selection of ;;
;; attributed blocks to process. This selection may include standard ;;
;; or dynamic attributed block references. ;;
;; ;;
;; Following a valid response, the program will iterate over the ;;
;; selection and will sum all numerical attribute values, grouping the ;;
;; values by common attribute tags. ;;
;; ;;
;; If multiple attribute tags hold numerical values, the user is ;;
;; presented with a dialog interface and prompted to select which ;;
;; attribute tags should be displayed in the resulting table, before ;;
;; being prompted to specify an insertion point for the table. ;;
;; ;;
;; The program will then automatically construct an AutoCAD table ;;
;; with properties inherited from the active Table Style. Each row ;;
;; of the table will display an attribute tag alongside the total of ;;
;; all numerical values held by that tag in the selection. ;;
;; ;;
;; If the program is configured to use field expressions in the table, ;;
;; the various totals will be automatically updated following valid ;;
;; modifications to the attribute values referenced by the fields. ;;
;; Note that this does not include the addition of new attributed ;;
;; blocks to the drawing, or the removal of attributed blocks ;;
;; referenced by the table fields. ;;
;; ;;
;; If field expressions are used, the formatting of the results will ;;
;; be dependent on the field formatting code set in the program; ;;
;; otherwise, the formatting of the totals displayed in the table ;;
;; will be dependent on the current unit & precision settings ;;
;; (that is, the values held by the LUNITS & LUPREC system variables ;;
;; respectively). ;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;; Version 1.0 - 2011-01-10 ;;
;; ;;
;; - First release. ;;
;;----------------------------------------------------------------------;;
;; Version 1.1 - 2015-12-21 ;;
;; ;;
;; - Program entirely rewritten. ;;
;; - User may choose which attribute tags to display in table. ;;
;; - Numerical values of constant attributes now included. ;;
;; - Fields may be used to link attribute values to table. ;;
;;----------------------------------------------------------------------;;

(defun c:attsum ( / *error* fld fmt fun hed idx ins lst obj sel spc tag ttl val )

(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)

(setq

;;----------------------------------------------------------------------;;
;; Program Parameters ;;
;;----------------------------------------------------------------------;;

;; Table title (e.g. "Attribute Sum") nil for none
ttl nil

;; Table Column Headings
hed '("Tag" "Total")

;; Use Field Expressions in Table? (t=yes; nil=no)
fld t

;; Field formatting
fmt "%lu6"

;;----------------------------------------------------------------------;;

)

(LM:startundo (LM:acdoc))
(if (= 1 (getvar 'cvport))
(setq spc (vla-get-paperspace (LM:acdoc)))
(setq spc (vla-get-modelspace (LM:acdoc)))
)
(cond
( (not (vlax-method-applicable-p spc 'addtable))
(princ "\nThis version of AutoCAD does not support tables.")
)
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
(princ "\nThe current layer is locked.")
)
( (not (setq sel (LM:ssget "\nSelect attributed blocks: " '(((0 . "INSERT")))))))
( (progn
(if fld
(setq fun (lambda ( obj val ) (strcat "+%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid obj) ">%).TextString>%")))
(setq fun (lambda ( obj val ) val))
)
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
(foreach att
(append
(vlax-invoke obj 'getattributes)
(vlax-invoke obj 'getconstantattributes)
)
(if (setq val (distof (vla-get-textstring att)))
(setq lst (attsum:assoc++ (strcase (vla-get-tagstring att)) (fun att val) lst))
)
)
)
(null (setq lst (vl-sort lst '(lambda ( a b ) (< (car a) (car b))))))
)
(princ "\nNo numerical attribute data found.")
)
( (and (setq tag (if (cdr lst) (LM:listbox "Select Tags to Display" (mapcar 'car lst) 1) (mapcar 'car lst)))
(setq ins (getpoint "\nSpecify point for table: "))
)
(if fld
(setq fun
(lambda ( x )
(list (car x)
(strcat
"%<\\AcExpr "
(substr (apply 'strcat (cdr x)) 2)
" \\f \"" fmt "\">%"
)
)
)
)
(setq fun (lambda ( x ) (list (car x) (rtos (apply '+ (cdr x))))))
)
(LM:addtable spc (trans ins 1 0) ttl
(cons hed (mapcar 'fun (vl-remove-if-not '(lambda ( x ) (member (car x) tag)) lst)))
nil
)
)
)
(LM:endundo (LM:acdoc))
(princ)
)

(defun attsum:assoc++ ( key val lst / itm )
(if (setq itm (assoc key lst))
(subst (vl-list* key val (cdr itm)) itm lst)
(cons (list key val) lst)
)
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)

;; ObjectID - Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
(eval
(list 'defun 'LM:objectid '( obj )
(if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj))
)
)
)
(LM:objectid obj)
)

;; List Box - Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil

(defun LM:listbox ( msg lst bit / dch des tmp rtn )
(cond
( (not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
(if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError Loading List Box Dialog.")
)
( t
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq rtn (set_tile "list" "0"))
(action_tile "list" "(setq rtn $value)")
(setq rtn
(if (= 1 (start_dialog))
(if (= 2 (logand 2 bit))
(read (strcat "(" rtn ")"))
(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
)
)
)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (and tmp (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
rtn
)

;; Add Table - Lee Mac
;; Generates a table at the given point, populated with the given data and optional title.
;; spc - [vla] VLA Block object
;; ins - [lst] WCS insertion point for table
;; ttl - [str] [Optional] Table title
;; lst - [lst] Matrix list of table cell data
;; eqc - [bol] If T, columns are of equal width
;; Returns: [vla] VLA Table Object

(defun LM:addtable ( spc ins ttl lst eqc / dif hgt i j obj stn sty wid )
(setq sty
(vlax-ename->vla-object
(cdr
(assoc -1
(dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "acad_tablestyle")))
(getvar 'ctablestyle)
)
)
)
)
)
(setq hgt (vla-gettextheight sty acdatarow))
(if (LM:annotative-p (setq stn (vla-gettextstyle sty acdatarow)))
(setq hgt (/ hgt (cond ((getvar 'cannoscalevalue)) (1.0))))
)
(setq wid
(mapcar
'(lambda ( col )
(apply 'max (mapcar '(lambda ( str ) (LM:addtable:textwidth str hgt stn)) col))
)
(apply 'mapcar (cons 'list lst))
)
)
(if (and ttl (< 0.0 (setq dif (/ (- (LM:addtable:textwidth ttl hgt stn) (apply '+ wid)) (length wid)))))
(setq wid (mapcar '(lambda ( x ) (+ x dif)) wid))
)
(setq obj
(vla-addtable spc
(vlax-3D-point ins)
(1+ (length lst))
(length (car lst))
(* 2.0 hgt)
(if eqc
(apply 'max wid)
(/ (apply '+ wid) (float (length (car lst))))
)
)
)
(vla-put-regeneratetablesuppressed obj :vlax-true)
(vla-put-stylename obj (getvar 'ctablestyle))
(setq i -1)
(if (null eqc)
(foreach col wid
(vla-setcolumnwidth obj (setq i (1+ i)) col)
)
)
(if ttl
(progn
(vla-settext obj 0 0 ttl)
(setq i 1)
)
(progn
(vla-deleterows obj 0 1)
(setq i 0)
)
)
(foreach row lst
(setq j 0)
(foreach val row
(vla-settext obj i j val)
(setq j (1+ j))
)
(setq i (1+ i))
)
(vla-put-regeneratetablesuppressed obj :vlax-false)
obj
)

(defun LM:addtable:textwidth ( str hgt sty / box obj tmp )
(if
(and (wcmatch str "*%<*>%*")
(setq tmp
(entmakex
(list
'(00 . "TEXT")
'(10 0.0 0.0 0.0)
(cons 01 str)
(cons 40 hgt)
(cons 07 sty)
)
)
)
)
(progn
(setq obj (vlax-ename->vla-object tmp))
(vla-put-textstring obj "")
(vla-put-textstring obj str)
(setq str (vla-get-textstring obj))
(entdel tmp)
)
)
(if
(setq box
(textbox
(list
(cons 01 str)
(cons 40 hgt)
(cons 07 sty)
)
)
)
(+ (* 2.5 hgt) (- (caadr box) (caar box)))
0.0
)
)

;; Annotative-p - Lee Mac
;; Returns T if the given Textstyle is annotative

(defun LM:annotative-p ( sty )
(and (setq sty (tblobjname "style" sty))
(setq sty (cadr (assoc -3 (entget sty '("acadannotative")))))
(= 1 (cdr (assoc 1070 (reverse sty))))
)
)

;; Start Undo - Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)

;; End Undo - Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)

;; Active Document - Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
(strcat
"\n:: SumAttributes.lsp | Version 1.1 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"attsum\" to Invoke ::"
)
)
(princ)

;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;

EXAMPLE.dwg

[dlanorh]

Welcome to CADTutor

 

Try this. No frills

 

(defun c:sumatts ( /  *error* c_doc c_spc flg ss obj tot txt pt)
  (vl-load-com)
  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        flg T
  );end_setq

  (while flg
    (prompt "\nSelect Block : ")
    (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT")(66 . 1))))
    (cond (ss
            (setq obj (vlax-ename->vla-object (ssname ss 0)) tot 0.0)
            (foreach r (list "D0" "D1" "D2")
              (vl-some '(lambda (h) (if (= (strcase (vlax-get h 'tagstring)) r) (setq tot (+ tot (atof (vlax-get h 'textstring)))))) (vlax-invoke obj 'getattributes))
            )
            (setq txt (strcat "L=" (if (zerop (rem tot 1.0)) (itoa (fix tot)) (rtos tot 2 1))) pt (getpoint "\nSelect Text Insertion Point : "))
            (vlax-invoke c_spc 'addmtext pt 1 txt)
          )
          (t (setq flg nil))
    );end_cond
  );end_while
  (princ)
);end_defun

It will loop and allow a single selection until you make a null selection. (left click mouse on an empty area of the screen, press enter or right click mouse)

 

Once a valid selection is made (block with attributes). The lisp will search for three specific tags in the block (D0 D1 & D2) and will sum their values.

You will then be asked to select an insertion point for the mtext. If there is no decimal part to the total this will be an integer, if there is a decimal part it will be rounded to 1 decimal place.

 

You will need to set the correct layer, text style and text height (type textsize once the text style is set)

 

Edited May 6, 2020 by dlanorh
code edit

[M.Nagaty]

Thank you, Awesome!

This is exact what I needed, but is there any way to link values with total value (If attribute value modified the total length update accordingly)?

 

Thank you again. 

 

[dlanorh]

On 07/05/2020 at 00:31, M.Nagaty said:

Thank you, Awesome!

This is exact what I needed, but is there any way to link values with total value (If attribute value modified the total length update accordingly)?

 

Thank you again. 

 

 

Sorry, I missed your reply yesterday. Will have a think about this.

[BIGAL]

Fields can add values remember seeing it somewhere would have to think about where.

[dlanorh]

7 hours ago, BIGAL said:

Fields can add values remember seeing it somewhere would have to think about where.

 

I'm not sure a field in a text item can sum the values of three specific attributes.

[Jonathan Handojo]

I thought so too... If I know, field values are very long, so I think it's possible, just super long

[dlanorh]

Found what I thought could be an answer, by adding another attribute and giving that a field formula that was the sum of the 3 attribute values. Idea HERE

 

This summed the default values of the 3 attributes but wouldn't update when the attribute values were changed. (attsync or regen/regenall) 

I'm not very experienced with fields so perhaps someone more experienced in fields could take a look. This is probably going to be a moment.

 

I've renamed the anonymous block to "test" in the attached drawing. There is one insert with default values.

 

 

EXAMPLE(1).dwg

Edited May 9, 2020 by dlanorh
Forgot to attach dwg

[BIGAL]

I am happy to be told incorrect but I think the only way is to insert the block add d1 d2 d3 then put d4 as a field made up of "this blocks attribute values" not the block definition it was changing values just did something wrong in the + two fields. But did see 250+410 d1+d2 etc as answer. Lots of google answers, I copied the block can see the changes after RE. Need to look at field values comparing ID.

 

 

If I could find this maybe

 

[dlanorh]

8 hours ago, BIGAL said:

I am happy to be told incorrect but I think the only way is to insert the block add d1 d2 d3 then put d4 as a field made up of "this blocks attribute values" not the block definition it was changing values just did something wrong in the + two fields. But did see 250+410 d1+d2 etc as answer. Lots of google answers, I copied the block can see the changes after RE. Need to look at field values comparing ID.

 

Good catch Alan

[dlanorh]

OK. Solved the problem. Found a topic on the Autodesk Forums where it was solved by @steven-g. It needed to be turned into a dynamic block, Once inserted and the visibility parameter is toggled and it updates on regen. 

EXAMPLE(1).dwg

[BIGAL]

This was something I was working on but its not working was getting there doing something wrong in the text string so any one else have a go have to do some other things now. Test on existing block or insert new put in all 4 dummy values. I notice that formula changes the .textstring to fldptr.

 

(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))

(setq obj (vlax-ename->vla-object (car (entsel "Pick object "))))

(setq lst '())
(foreach att(vlax-invoke obj 'getattributes)
(princ  "\n")
(setq lst (cons  (strcat "%<\\_FldPtr " 
(vlax-invoke-method (vla-get-Utility  acdoc) 'GetObjectIdString att :vlax-false)
">%"
 ) lst ))
)
(setq str nil)
(setq x (length lst))
(setq str (strcat "%<\\AcExpr ("
(nth (setq  x (- x 1)) lst) " +"
(nth (setq  x (- x 1)) lst) " +"
(nth (setq  x (- x 1)) lst) ")>%"
)
)

(setq x 1 y 4)
(foreach att(vlax-invoke obj 'getattributes)
(if (= x y)
(Vla-put-textstring att str)
)
(setq x (+ x 1))
)

 

[hanhphuc]

i realised Bricscad has many issue in field automation

posted in other forum , i only managed to solve ACAD version, ATM Bricscad field manually 

 

 

On 5/11/2020 at 11:30 AM, BIGAL said:

This was something I was working on but its not working was getting there doing something wrong in the text string so any one else have a go have to do some other things now. Test on existing block or insert new put in all 4 dummy values. I notice that formula changes the .textstring to fldptr.

 

"%<\\_FldPtr ....

 

 

In ACAD formula dialog fldptr not consistant it changes

try this snippet also returns %<\\_FldPtr ..........>% but still clueless

(and
(setq en (car(entsel "\nPick Table ")))
(setq table (vlax-ename->vla-object en))
(vla-GetFormula table 2 1 0 ) ;2nd row & 1st column
)

 

In BCAD Field-Mtext disappear after clicking it to update kinda weird 

(and
(setq str "")
(while
  (setq en (car (nentsel "\nPick number in table ")))
    (if en (setq obj (vlax-ename->vla-object en)
                 $ (vla-FieldCode obj)
                 $ (substr $ 1 (vl-string-search " \\f " $))
                 $ (substr $ (1+ (vl-string-search "%<\\AcObjProp" $)))
                 str (strcat str $ "+")
                 
           )
    )
    $
)

  (entmakex (list '(0 . "MTEXT")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbMText")
                  '(40 . 100)
                  '(50 . 0)
                  (cons 10 (getvar 'viewctr))
                  (cons 1 (strcat "%<\\AcExpr (" str "0)>%"))
            )
  )

)

 

 

 

 

 

 

[Romiui]

3 minutes ago, hanhphuc said:

i realised Bricscad has many issue in field automation

posted in other forum , i only managed to solve ACAD version, ATM Bricscad field manually 

 

 

 

In ACAD formula dialog fldptr not consistant it changes

try this snippet also returns %<\\_FldPtr ..........>% but still clueless

(and
(setq en (car(entsel "\nPick Table ")))
(setq table (vlax-ename->vla-object en))
(vla-GetFormula table 2 1 0 ) ;2nd row & 1st column
)

 

In BCAD Field-Mtext disappear after clicking it to update kinda weird 

(and
(setq str "")
(while
  (setq en (car (nentsel "\nPick number in table ")))
    (if en (setq obj (vlax-ename->vla-object en)
                 $ (vla-FieldCode obj)
                 $ (substr $ 1 (vl-string-search " \\f " $))
                 $ (substr $ (1+ (vl-string-search "%<\\AcObjProp" $)))
                 str (strcat str $ "+")
                 
           )
    )
    $
)

  (entmakex (list '(0 . "MTEXT")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbMText")
                  '(40 . 100)
                  '(50 . 0)
                  (cons 10 (getvar 'viewctr))
                  (cons 1 (strcat "%<\\AcExpr (" str "0)>%"))
            )
  )

)

 

 

 

 

 

 

will you please help me out with my issue !?

i need urgent help please please !
 

 

 

 

[hanhphuc]

On 5/12/2020 at 3:36 PM, Romiui said:

will you please help me out with my issue !?

i need urgent help please please !
Romiui created a topic in AutoLISP, Visual LISP & DCL

 

 

 

hi please be patient , this post is nothing related to this topic: sum-of-attribute-values at all 

 

 

[BIGAL]

Can only solve one at a time and we do have other things to do than always write free answers on Cadtutor.

[dlanorh]

On 07/05/2020 at 00:31, M.Nagaty said:

Thank you, Awesome!

This is exact what I needed, but is there any way to link values with total value (If attribute value modified the total length update accordingly)?

 

Thank you again. 

 

 

@M.Nagaty  Finally got round to solving this. The lisp has a small section of user setq's which will allow you to change the the text style and number precision. This is initially set to 0 (zero decimal places). The text style is changed to this style and you are asked to set the text height (current default for the style is shown and can be selected by a right click or return). It is then just a case of selecting the block and mtext location as before. This is in a continuous loop as previously. To exit the loop make a null block selection. The Mtext is inserted in the same layer as the block. To update the mtext if any changes are made to the block attributes, just type regen on the command line.

 

(defun c:sumatts ( /  *error* c_doc c_spc sv_lst sv_vals flg txt_sty prec tht otht ss obj tot lyr oid pt)

  (defun *error* ( msg )
    (if (and otht (= (strcase (getvar 'textstyle)) txt_sty) (/= otht tht)) (setvar 'textsize otht))
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode 'textstyle 'textsize 'clayer)
        sv_vals (mapcar 'getvar sv_lst)
        flg T
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

; user settings
  (setq txt_sty "ARMACAD" ;sets the text style to use
        prec 0            ;this sets the total precision 0 = no decimal places 1 = 1 decimal place etc
  );end_setq

  (cond ( (/= (strcase (getvar 'textstyle)) txt_sty) (setvar 'textstyle txt_sty)))
  (setq tht (getvar 'textsize) otht tht)

  (initget 6)
  (setq tht (cond ( (getreal (strcat "\nEnter Text Height <" (rtos tht 2 1) "> : "))) (t tht)))
  (setvar 'textsize tht)

  (while flg
    (prompt "\nSelect Block : ")
    (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT")(66 . 1))))
    (cond (ss
            (setq obj (vlax-ename->vla-object (ssname ss 0)) tot "%<\\AcExpr " lyr (vlax-get obj 'layer))
            (foreach r (list "D0" "D1" "D2")
              (vl-some '(lambda (h) 
                          (if (= (strcase (vlax-get h 'tagstring)) r) 
                            (setq oid (itoa (vlax-get-property h 'objectid)) 
                                  tot (strcat tot "%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Textstring>% + ")
                            )
                          )
                        )
                        (vlax-invoke obj 'getattributes)
              );end_vl-some
            );end_foreach
            (setq tot (strcat tot " 0.0 \\f \"%lu2%pr" (itoa prec) "%ps[L=,]\">%")
                  pt (getpoint "\nSelect Text Insertion Point : ")
            )
            (vlax-put (vlax-invoke c_spc 'addmtext pt 1 tot) 'layer lyr)
          )
          (t (setq flg nil))
    );end_cond
  );end_while

  (if (/= otht tht) (setvar 'textsize otht))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

 

[BIGAL]

Had another go and seems to be working, there is no reference to what the block should be doing say x scale.

 

; add attributes and display in another attribute
; this example is add att1 att2 att3 display total att4
; By Alanh May 2020 info@alanh.com.au


(defun c:test ( / obj lst x str)
(setq oldatt (getvar 'attdia))
(setvar 'attdia 0)
(command "-insert" "test" (getpoint "\npick point") 1 1 0 (getstring "\nEnter Att1 ") (getstring "\nEnter Att2 ") (getstring "\nEnter Att3 ") "-")
(setq obj (vlax-ename->vla-object (entlast)))
(setq lst '())
(foreach att(vlax-invoke obj 'getattributes)
(princ  "\n")
(setq lst (cons  (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
(vlax-invoke-method (vla-get-Utility  (vla-get-activedocument (vlax-get-acad-object))) 'GetObjectIdString att :vlax-false)
">%).Textstring>%"
 ) lst ))
)
(setq str nil)
(setq x (length lst))
(setq str (strcat "%<\\AcExpr ("
(nth (setq  x (- x 1)) lst) "+"
(nth (setq  x (- x 1)) lst) "+"
(nth (setq  x (- x 1)) lst) ")>%"
)
)
(setq x 1 y 4)
(foreach att(vlax-invoke obj 'getattributes)
(if (= x y)
(Vla-put-textstring att str)
)
(setq x (+ x 1))
)
(setvar 'attdia oldatt)
(princ)
)
(c:test)

Could be expanded into a more universal like '(1 + 2 + 3 4) or (1 * 2 3) for area

Edited May 26, 2020 by BIGAL

[mjab8]

Hi, my Area attribute have a suffix m2 (AT). This 2 is a superscript for square meter. Can I get the sum of all these Areas and insert as a field in a table as in Lee's original lisp.

This suffix, an alphanumeric is preventing this lisp from getting this total Area.  Thank you.

[BIGAL]

The attributes are text not fields ?