lisp to calculate sum of numbers in a selected area-field

...a lisp to calculate sum for texts or mtexts situated in a selected region (area), and to be a field , to can update it after modifications... anybody has something like this?

Add all the text up yep thats ok it will be out there just search.

and to be a field

what do you mean ?

I mean, to have a lisp that works similat to sum field in a table.... if i modify (or i add) a number inside an area (selected before...), after making redraw to have a sum of all numbers inside that area... ( a rectangle). So, something similar to a sum field in a table, but this lisp to work outside of a table, for a rectangle ... sorry for my english...

Can you upload a dwg file to explain what you want the routine would be?

Drawing attached

SUM FIELD RECTANGLE.dwg

With that kind of condition, a "FIELD" value wouldn't work without user intervention. Harry, you need a helper routine to work this out. Definitely not automagically upon "redraw"

Can be with user intervention, like...selecting the rectangle...no problem

I mean, to have a lisp that works similat to sum field in a table.... if i modify (or i add) a number inside an area (selected before...), after making redraw to have a sum of all numbers inside that area... ( a rectangle). So, something similar to a sum field in a table, but this lisp to work outside of a table, for a rectangle ... sorry for my english...

hi Harry,

The sum formula in acField expression is only applied for acad Table,

so what we can do now is just modifying "fake" Field which is just a TEXT object

ie: Select the Texts -> [Enter] -> pick the "Field" text to update.

;http://www.cadtutor.net/forum/showthread.php?87827-lisp-to-calculate-sum-of-numbers-in-a-selected-area-field
;hp# 25/07/14
(defun c:sum (/ e ss i l)
 (prompt "\nSelect Area, then [Enter].. ")
 (if (setq ss (ssget))
   (progn (setq i 0)
   (repeat (sslength ss)
     (setq l (cons (cdr (assoc 1 (entget (ssname ss i)))) l)
	   i (1+ i)
	   ) ;_ end of setq
     ) ;_ end of repeat
   (if (and(setq l (vl-remove nil l))
	(setq e (car(entsel "\nPick Field Text..")))
	  (assoc 1 (entget e) )
	   )
     (vla-put-textstring (vlax-ename->vla-object e)
       (apply '+ (mapcar 'atof l)))
     ) ;_ end of if
   ) ;_ end of progn
   ) ;_ end of if
(princ)
 ) ;_ end of defun

Harry,

It's easier if you use specific layers for text and for field-object.

(defun C:UPDSUM ( / CONTUR E FIELD_OBJECT I L P1 PL SST SS_FIELD)
 (princ "\nPick contur: ")
 (if
   (setq contur (ssget ":E:S" '((0 . "LWPOLYLINE"))))
   (progn
     (setq pl (mapcar 'cdr (vl-remove-if '(lambda (a) (/= (car a) 10)) (entget (ssname contur 0)))))
     (if
       (setq sst (ssget "WP" pl '((0 . "*TEXT"))));(8 . "TEXT_layer")
       (progn
         (repeat (setq i (sslength sst))
           (setq e (vlax-ename->vla-object (ssname sst (setq i (1- i)))))
           (if
             (distof (vla-get-textstring e))
             (setq l (cons
                       (strcat
                         "%<\\AcObjProp Object(%<\\_ObjId "
                          (itoa (vla-get-ObjectID e))
                         ">%).TextString>%+"
                         )
                       l
                       )
                   )
             )
           )
         (if
           (or
             (and
               (setq ss_field (ssget "WP" pl '((0 . "*TEXT"))));(8 . "FIELD_LAYER")
               (= 1 (sslength ss_field))
             )
             (progn
               (princ "\nSelect field object: ")
               (setq ss_field (ssget ":E:S:L" '((0 . "*TEXT"))));(8 . "FIELD_LAYER")
             )
           )
           (setq field_object (vlax-ename->vla-object (ssname ss_field 0)))
           (if
             (setq p1 (getpoint "\nSelect a point to insert new field: "))
             (setq field_object
               (vlax-ename->vla-object
                 (entmakex
                   (list
                     '(0 . "TEXT")
;;;                      '(8 . "FIELD_LAYER")
                     '(1 . "0.00")
                     (cons 10 (trans p1 1 0))
                     (cons 40 (getvar 'textsize))
                   )
                 )
               )
             )
             (princ "\nNothing to do")
             )
           )
         (if field_object
           (vla-put-textstring
             field_object
             (strcat
               "%<\\AcExpr ("
               (apply 'strcat l)
               "0)>%"
               )
             )
           )
         )
       )
     )
   )
 (princ)
 )

P.S. I do not understand why use MTEXT for simple numbers... You can run into trouble with special formats.

Let me do it for you (map_sset (ssget "X" '((0 . "MTEXT"))) '(lambda (e) (command "explode" e)) nil)

Another lisp, another beer for Stefan Thanks!

hi Harry,

 

....so what we can do now is just modifying "fake" Field which is just a TEXT object

 

ie: Select the Texts -> [Enter] -> pick the "Field" text to update.

I was thinking more or less like Stefans' code hanhphuc, , select the "box" and use an actual field code. That way if the user change or delete a text inside the box, the total will be updated.

When the user start adding a new text object on the box that's where "user intervention" comes into play.

Harry,

It's easier if you use specific layers for text and for field-object.

I concur, earlier i was thinking of incorporating XDATA as placeholder for "grouping", Yes i will still use field code, but i wanted to "update" all in one go without selecting the box and Text entity which holds the field value.

Nice code btw

What do you guys think? any thoughts on this?

... i wanted to "update" all in one go without selecting the box and Text entity which holds the field value.

In my code (though, not exactly as it is; requires some minor changes regarding layer filtering), if the text holding the field formula is in the area (inside of rectangle), the sum is automatically updated, without selecting it.

Nice code btw

Thanks pBe

Another lisp, another beer for Stefan Thanks

Another way is using reactors, just like this:

(vl-load-com)
(defun getsum (b)
  (rtos (apply '+ (mapcar '(lambda(x) (atof (vla-get-TextString x))) b)) 2 0)
)

(defun modifyObj (notifier-object obj_reactor parameter-list / tm )
   (if (/= (setq tm (getsum (vlr-owners obj_reactor)))
           (vla-get-TextString (car (vlr-data obj_reactor))))
     (vla-put-TextString (car (vlr-data obj_reactor)) tm))
)

(defun c:TSum (/ ss rst lst) 
 (prompt "\nChoose element texts:")
 (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT"))))))
rst (vlax-ename->vla-object (car (entsel "\nChoose result text:")))
lst (mapcar 'vlax-ename->vla-object ss))
 (vla-put-TextString rst (getsum lst))
 (setq obj_reactor (vlr-pers (vlr-object-reactor lst (list rst)
			'((:vlr-objectClosed . modifyObj)))))  
 (princ)
)

You set the connections only once between texts and result text with command TSUM.

When you modify the element texts, the result text also change.

Save you drawing before closing to save reactors.

Next time opening it, the connection still exists. But you have to load this lisp again to let acad knows the function.

The routine still doesn't have stuff about adding or deleting element texts yet.

In my code (though, not exactly as it is; requires some minor changes regarding layer filtering), if the text holding the field formula is in the area (inside of rectangle), the sum is automatically updated, without selecting it.

 

 

Thanks pBe

 

Cheers my friend!

Thanks Stafan for sharing nice code! That's was Real Field. & Nice to meet you guys

Another way is using reactors, just like this:

 

You set the connections only once between texts and result text with command TSUM.

When you modify the element texts, the result text also change.

Save you drawing before closing to save reactors.

Next time opening it, the connection still exists. But you have to load this lisp again to let acad knows the function.

The routine still doesn't have stuff about adding or deleting element texts yet.

7o7 good try reactor idea. i thank you both ideas could help Harry & the rest in correct way

I was thinking more or less like Stefans' code hanhphuc, , select the "box" and use an actual field code. That way if the user change or delete a text inside the box, the total will be updated.

When the user start adding a new text object on the box that's where "user intervention" comes into play.

If you wanna select box, try add this & modify ssget..

;in vanilla... 
;...
(prompt "\nPick Area box  ")
 (if
 (setq e (car(entsel)))
 (setq lst ('((l / i)
  (cdr
   (foreach
    x
    (mapcar 'cdr l)
    (if
     (listp x)
     (setq i (cons x i))
     )
    )
   )
  )
 (entget e)
 ))
)
 
(if (setq ss (ssget [color="red"]"WP" lst '((0 . "*TEXT"))))[/color]
...
...
...

pick box-> then pick field text

As stefan mentioned filter Layers can also update Field without selecting.

ssget with filters can play some trick

A very good idea 7o7

You may need to consider if any of the text objects has been erased .

Thanks Tharwat for the comment.

Maybe this is better, you can erase some texts . If adding, just do the TSUM again with all the element texts.

(vl-load-com)
(defun getsum (b)
  (rtos (apply '+
  (mapcar '(lambda(x)
	     (if (vlax-erased-p x) 0 (atof (vla-get-TextString x)))) b)) 2 0)
)

(defun modifyObj (notifier-object obj_reactor parameter-list / )
 (vla-put-TextString (car (vlr-data obj_reactor))
   (getsum (vlr-owners obj_reactor)))
)

(defun eraseObj (notifier-object obj_reactor parameter-list / )   
 (vlr-owner-remove obj_reactor notifier-object)  
)

(defun c:TSum (/ ss rst lst data lreac reac) 
 (prompt "\nChoose element texts:")
 (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT"))))))
rst (vlax-ename->vla-object (car (entsel "\nChoose result text:")))
lst (mapcar 'vlax-ename->vla-object ss))
 
 (if (assoc rst (setq data (mapcar 'vlr-data
(setq lreac (cdar (vlr-reactors :vlr-object-reactor))))))
   (foreach item lst
     (if (not (member item (vlr-owners (setq reac (nth (vl-position (list rst) data) lreac)))))
(vlr-owner-add reac item)))
   (setq obj_reactor (vlr-pers (vlr-object-reactor lst (list rst)
			'((:vlr-objectClosed . modifyObj)
			  (:vlr-erased . eraseObj)))))
 )  
 (vla-put-TextString rst (getsum lst))
 (princ)
)

Thanks Tharwat for the comment.

Maybe this is better, you can erase some texts . If adding, just do the TSUM again with all the element texts.

Very nice indeed

I am one of the others whom learning from you from this thread about reactors , so one last thing to have a very complete example for us is that to consider if a user erased the text result before any of the other connected texts , otherwise would have the same error message for erasing as indicated before this last modification .

If you could explain the parts that related to reactors , it would be great help from you .

Appreciate your inputs too much .

When you delete the result test, nothing happens. But if you modify the element text of that reactor, the *error* function will be triggered and error messages printed.

So in this case, you have to redefine the *error* function to catch the error, something like this:

(defun *error* (msg)
 (setq tmperr *error*)
 (foreach item (setq data (mapcar 'vlr-data
              (setq lreac (cdar (vlr-reactors :vlr-object-reactor)))))
   (if (vlax-erased-p (car item))
     (vlr-remove (nth (vl-position item data) lreac)))
 )
 (setq *error* tmperr)
)