adjust the following lisp to select some texts by one click instead of text by text

[shadi]

hello everybody , hope u all are great  ... i have this lisp to get sum of some texts in autocad by choosing them one by one , but instead i wanna select those texts in one time by one selection click for them all ... i really appreciate ur help 

thanks in advance  

 

 

;; wrriten by dlanorh from  cadtutor
(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun

(vl-load-com)

(defun c:t+ ( / *error* sv_lst sv_vals ent elst el num xsf ans tot qflg nlst sel pt txt)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_defun

  (setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 3 1))

  (while (not tot)
    (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : ")))))
    (cond ( (wcmatch (cdr (assoc 0 el)) "*TEXT")
            (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString")) xsf (cdr (assoc 41 el))))
                  (t (setq num (atof (getpropertyvalue ent "Text")) xsf 1.0))
            );end_cond
            (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")) (t (setq tot num)))
          )
          (t (alert "Not a Text Entity"))
    );end_cond
    (cond (num (setq nlst (cons ent nlst))))
  );end_while

  (while (not qflg)
    (setq sel (entsel "\nSelect Next Text Number Entity : "))
    (cond ( (not sel)
            (initget "Yes No")
            (setq ans (cond ( (getkword "\nSelection Finished [Yes/No] <No>")) ("No")))
            (if (= ans "Yes") (setq qflg T))
          )
    );end_cond
    (cond ( (and (not qflg) sel)
            (setq elst (entget (setq ent (car sel))))
            (cond ( (and (wcmatch (cdr (assoc 0 elst)) "*TEXT") (not (vl-position ent nlst)))
                    (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString"))))
                          (t (setq num (atof (getpropertyvalue ent "Text"))))
                    );end_cond
                    (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")))
                  )
                  ( (vl-position ent nlst) (alert "Already Selected") (setq num nil))
                  (t (alert "Not a Text Entity"))
            );end_cond
            (if num (setq tot (+ tot num) nlst (cons ent nlst) num nil))
          )
    );end_cond
  );end_while

  (cond ( (and tot qflg)
          (setq pt (getpoint "\nSelect Total Insertion Point : ")
                txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))
          );end_setq
          (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) xsf)
          (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o)))
        )
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

 

[BIGAL]

Ok a few things (ssget '((0 . "TEXT"))) will allow you to select as many as you want at a time by window or one by one. So you want total of text picked ? 

 

(defun c:countext ( / tot val ss)
(setq tot 0.0)
(setq ss (ssget '((0 . "TEXT"))))
(repeat (setq x (sslength ss))
(setq val (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x))))))))
(setq tot (+ tot val))
)
(princ)
)
(c:countext)

 

[shadi]

36 minutes ago, BIGAL said:

Ok a few things (ssget '((0 . "TEXT"))) will allow you to select as many as you want at a time by window or one by one. So you want total of text picked ? 

 

(defun c:countext ( / tot val ss)
(setq tot 0.0)
(setq ss (ssget '((0 . "TEXT"))))
(repeat (setq x (sslength ss))
(setq val (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x))))))))
(setq tot (+ tot val))
)
(princ)
)
(c:countext)

 

thank u very much for ur reply ... the topic lisp is to pick some texts one by one and each time asking me if i finished or not so if finished the lisp will ask me to where i will put the sum , i just want to select those texts by one selection and still it asks me if i finished or not ...  i am sorry for my request , i need that sequence in the topic lisp but this time adjusted for select some texts instead if one by one .. can u please adjust the topic lisp with my request 

[exceed]

1 hour ago, shadi said:

thank u very much for ur reply ... the topic lisp is to pick some texts one by one and each time asking me if i finished or not so if finished the lisp will ask me to where i will put the sum , i just want to select those texts by one selection and still it asks me if i finished or not ...  i am sorry for my request , i need that sequence in the topic lisp but this time adjusted for select some texts instead if one by one .. can u please adjust the topic lisp with my request 

(defun c:countext ( / tot val ss)
  (setq tot 0.0)
  (setq ans "")
  (while (= ans "")
    (setq ss (ssget '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq val (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x))))))))
      (setq tot (+ tot val))
    )
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  )  
  (princ "\n finished, result is = ")
  (princ tot)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)


(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun

 

little bit edit BIGAL's code, try this

Edited July 1, 2022 by exceed

[shadi]

22 hours ago, exceed said:

(defun c:countext ( / tot val ss)
  (setq tot 0.0)
  (setq ans "")
  (while (= ans "")
    (setq ss (ssget '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq val (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x))))))))
      (setq tot (+ tot val))
    )
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  )  
  (princ "\n finished, result is = ")
  (princ tot)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)


(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun

 

little bit edit BIGAL's code, try this

thank u too much exceed  , it is working very well , just i need one adjusting for this lisp to delete the summed texts after make sum of them (after putting the sum on the selected location)  ... i see the sum ignore no number texts and continue to get the some of texts with numbers and that is pretty good , so can delete option ignores too the no number selected texts and just delete the summed number texts ? is that possible?   

Edited July 2, 2022 by shadi

[tombu]

When saving downloaded code adding the link to where you downloaded it as a comment like

; https://www.cadtutor.net/forum/topic/71014-lisp-to-run-a-calculation/page/2/#comment-570635

to the lisp so you can use it for follow-up questions as the link provides more complete information on what it was created to do and how it worked without needing to repost the already posted code.

[BIGAL]

Need to add does string have any characters not in range (chr 48-57), "0-9"  then is not pure number. Note if -ve can be a string or a number so would do extra check is 1st character. This is a lambda type thing very fast.

 

Edited July 2, 2022 by BIGAL

[shadi]

13 minutes ago, BIGAL said:

Need to add does string have any characters not in range (chr 48-57), "0-9"  then is not pure number. Note if -ve can be a string or a number so would do extra check is 1st character. This is a lambda type thing very fast.

 

i appreciate ur help , but sorry that sounds complicated for me , please can u adjust it in the lisp 

[exceed]

27 minutes ago, shadi said:

i appreciate ur help , but sorry that sounds complicated for me , please can u adjust it in the lisp 

 

http://www.lee-mac.com/parsenumbers.html

[BIGAL]

Try this, you can add more characters like % & etc.

 

(defun c:countext ( /  val ss txt pt)
(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun
(setq tot 0.0)
(setq ss (ssget '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
(repeat (setq x (sslength ss))
(setq val (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))
(if (= (wcmatch (strcase val) "*A*,*B*,C*,*D*,*E*,*F*,G*,*H*,*I*,*J*,*K*,*L*,
*M*,*N*,*O*,*P*,*Q*,*R*,*S*,*T*,*U*,*V*,*W*,*X*,*Y*,*Z*") nil)
(princ (setq tot (+ tot (atof val))))
(princ "\nskip")
)
)
(setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
(princ)
)

 

Edited July 2, 2022 by BIGAL

[shadi]

7 hours ago, exceed said:

 

http://www.lee-mac.com/parsenumbers.html

i am sorry , it doesnt work with me ... but anyway , thank u fo ur help 

[shadi]

12 hours ago, BIGAL said:

Try this, you can add more characters like % & etc.

 

(defun c:countext ( /  val ss txt pt)
(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun
(setq tot 0.0)
(setq ss (ssget '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
(repeat (setq x (sslength ss))
(setq val (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))
(if (= (wcmatch (strcase val) "*A*,*B*,C*,*D*,*E*,*F*,G*,*H*,*I*,*J*,*K*,*L*,
*M*,*N*,*O*,*P*,*Q*,*R*,*S*,*T*,*U*,*V*,*W*,*X*,*Y*,*Z*") nil)
(princ (setq tot (+ tot (atof val))))
(princ "\nskip")
)
)
(setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
(princ)
)

 

thank u BIGAL  , it working good as the previous lisp , but unfortunately , it doesnt delete the summed number texts and i need that necessarily please

i got new idea if u can do it , to combine the selected string texts with the sum of selected number texts in one text , as example  i have 4 texts ; AS , 4 , 6 , 10 so i wanna select them all by one window selection like in this lisp and then ask me to put the result in new location and the result will be new text like this" AS - 20  " and in same time the selected texts by window should be deleted so as u can say the lisp work im way to convert  "AS ", "4" , "6" , "10" to "AS - 20"   .... i hope that is clear 

Edited July 2, 2022 by shadi

[tombu]

17 hours ago, shadi said:

i am sorry , it doesn't work with me ... but anyway , thank you for your help 

Lee Mac's Text Calculator is a good example of using his Parse Numbers function to perform arithmetic operations on text containing numerical data, placing the result of such calculations as an MText object in the drawing, these text objects may be Single-line Text, Multi-line Text, a Dimension, Multileader or Attribute. 

 

If the text of the selected object contains multiple numbers, the user is prompted to choose the number to use in subsequent calculations. After selection, the user is presented with a dialog interface from which an arithmetic operation may be selected or the result of the calculations so far may be placed in the drawing.

[shadi]

14 hours ago, tombu said:

Lee Mac's Text Calculator is a good example of using his Parse Numbers function to perform arithmetic operations on text containing numerical data, placing the result of such calculations as an MText object in the drawing, these text objects may be Single-line Text, Multi-line Text, a Dimension, Multileader or Attribute. 

 

If the text of the selected object contains multiple numbers, the user is prompted to choose the number to use in subsequent calculations. After selection, the user is presented with a dialog interface from which an arithmetic operation may be selected or the result of the calculations so far may be placed in the drawing.

thank u tombu , but still it doesnt help me.. i have a lot of texts in cad file and they should be picked to get sum of closed texts together into new text and delete the summed texts and i should repeat for all close texts in the cad file , texts could be more than 400 text  .. and i should have the result in the way i explained to bigal 

 

 

On 7/2/2022 at 11:42 AM, shadi said:

thank u BIGAL  , it working good as the previous lisp , but unfortunately , it doesnt delete the summed number texts and i need that necessarily please

i got new idea if u can do it , to combine the selected string texts with the sum of selected number texts in one text , as example  i have 4 texts ; AS , 4 , 6 , 10 so i wanna select them all by one window selection like in this lisp and then ask me to put the result in new location and the result will be new text like this" AS - 20  " and in same time the selected texts by window should be deleted so as u can say the lisp work im way to convert  "AS ", "4" , "6" , "10" to "AS - 20"   .... i hope that is clear 

 

[exceed]

7 hours ago, shadi said:

thank u tombu , but still it doesnt help me.. i have a lot of texts in cad file and they should be picked to get sum of closed texts together into new text and delete the summed texts and i should repeat for all close texts in the cad file , texts could be more than 400 text  .. and i should have the result in the way i explained to bigal 

 

 

 

 

 

Upper Left = tag text 1 + each number text has 1 number

Upper Right = tag text 1 + 1 number text has 2 numbers, get first number and print to prompt

Lower Left = tag text 2 case, combine with comma

Lower Right = countext2, countext with expression

 

 

(vl-load-com)
(defun c:countext ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt )
  (setq tot 0.0)
  (setq tagtxt "")
  (setq ans "")
  (setq texpression "=")
  (while (= ans "")
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq en (ssname ss (setq x (1- x))))
      (setq val (cdr (assoc 1 (entget en))))
      (setq val2 (LM:parsenumbers val))
      (setq val2len (length val2))
      (cond
        ((= val2len 0) 
          (if (= (strlen tagtxt) 0)
            (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
            (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
          )
          (vla-delete (vlax-ename->vla-object en))
        )
        ((= val2len 1)
          (setq tot (+ tot (car val2))) 
          (if (= (strlen texpression) 1)
            (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
            (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
          )
          (vla-delete (vlax-ename->vla-object en))
        )
        ((> val2len 1)
          (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ")
          (princ val2)
          (setq tot (+ tot (car val2)))       
          (if (= (strlen texpression) 1)
            (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
            (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
          )
          (vla-delete (vlax-ename->vla-object en))
        )

      )

    )
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  )  
  (princ "\n finished, result is = ")
  (princ tot)
  (princ "\n in expression = ")
  (princ texpression)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (setq resulttxt (strcat tagtxt " - " txt))
  (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)

(defun c:countext2 ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt )
  (setq tot 0.0)
  (setq tagtxt "")
  (setq ans "")
  (setq texpression "=")
  (while (= ans "")
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq en (ssname ss (setq x (1- x))))
      (setq val (cdr (assoc 1 (entget en))))
      (setq val2 (LM:parsenumbers val))
      (setq val2len (length val2))
      (cond
        ((= val2len 0) 
          (if (= (strlen tagtxt) 0)
            (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
            (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
          )
          (vla-delete (vlax-ename->vla-object en))
        )
        ((= val2len 1)
          (setq tot (+ tot (car val2))) 
          (if (= (strlen texpression) 1)
            (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
            (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
          )
          (vla-delete (vlax-ename->vla-object en))
        )
        ((> val2len 1)
          (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ")
          (princ val2)
          (setq tot (+ tot (car val2)))       
          (if (= (strlen texpression) 1)
            (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
            (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
          )
          (vla-delete (vlax-ename->vla-object en))
        )

      )

    )
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  )  
  (princ "\n finished, result is = ")
  (princ tot)
  (princ "\n in expression ")
  (princ texpression)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (setq resulttxt (strcat tagtxt " - " txt))
  (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (rh:em_txt (list (car pt) (- (cadr pt) (* 2 (cdr (assoc 40 el)))) (caddr pt)) texpression (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)


(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun


;; Parse Numbers  -  Lee Mac
;; Parses a list of numerical values from a supplied string.

(defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list str)
    )
)

 

how about this

countext - only result

countext2 - with expression

[shadi]

20 hours ago, exceed said:

 

 

Upper Left = tag text 1 + each number text has 1 number

Upper Right = tag text 1 + 1 number text has 2 numbers, get first number and print to prompt

Lower Left = tag text 2 case, combine with comma

Lower Right = countext2, countext with expression

 

 

(vl-load-com)
(defun c:countext ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt )
  (setq tot 0.0)
  (setq tagtxt "")
  (setq ans "")
  (setq texpression "=")
  (while (= ans "")
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq en (ssname ss (setq x (1- x))))
      (setq val (cdr (assoc 1 (entget en))))
      (setq val2 (LM:parsenumbers val))
      (setq val2len (length val2))
      (cond
        ((= val2len 0) 
          (if (= (strlen tagtxt) 0)
            (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
            (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
          )
          (vla-delete (vlax-ename->vla-object en))
        )
        ((= val2len 1)
          (setq tot (+ tot (car val2))) 
          (if (= (strlen texpression) 1)
            (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
            (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
          )
          (vla-delete (vlax-ename->vla-object en))
        )
        ((> val2len 1)
          (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ")
          (princ val2)
          (setq tot (+ tot (car val2)))       
          (if (= (strlen texpression) 1)
            (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
            (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
          )
          (vla-delete (vlax-ename->vla-object en))
        )

      )

    )
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  )  
  (princ "\n finished, result is = ")
  (princ tot)
  (princ "\n in expression = ")
  (princ texpression)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (setq resulttxt (strcat tagtxt " - " txt))
  (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)

(defun c:countext2 ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt )
  (setq tot 0.0)
  (setq tagtxt "")
  (setq ans "")
  (setq texpression "=")
  (while (= ans "")
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq en (ssname ss (setq x (1- x))))
      (setq val (cdr (assoc 1 (entget en))))
      (setq val2 (LM:parsenumbers val))
      (setq val2len (length val2))
      (cond
        ((= val2len 0) 
          (if (= (strlen tagtxt) 0)
            (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
            (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
          )
          (vla-delete (vlax-ename->vla-object en))
        )
        ((= val2len 1)
          (setq tot (+ tot (car val2))) 
          (if (= (strlen texpression) 1)
            (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
            (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
          )
          (vla-delete (vlax-ename->vla-object en))
        )
        ((> val2len 1)
          (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ")
          (princ val2)
          (setq tot (+ tot (car val2)))       
          (if (= (strlen texpression) 1)
            (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
            (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
          )
          (vla-delete (vlax-ename->vla-object en))
        )

      )

    )
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  )  
  (princ "\n finished, result is = ")
  (princ tot)
  (princ "\n in expression ")
  (princ texpression)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (setq resulttxt (strcat tagtxt " - " txt))
  (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (rh:em_txt (list (car pt) (- (cadr pt) (* 2 (cdr (assoc 40 el)))) (caddr pt)) texpression (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)


(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun


;; Parse Numbers  -  Lee Mac
;; Parses a list of numerical values from a supplied string.

(defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list str)
    )
)

 

how about this

countext - only result

countext2 - with expression

Wooooooooow , that is perfect really , thank u a lot for ur help exceed , it really helping a lot  ... just one thing i noticed if the text is string with number combined in it , the result will sum it too , as example if i have texts like ( "A2" , "5" , "2" ) the result will be "A - 9" instead of being "A2 - 7" ... is there code to adjust that in the lisp ? ... and really i thank u too much for ur help .. stay blessed 

[exceed]

2 hours ago, shadi said:

Wooooooooow , that is perfect really , thank u a lot for ur help exceed , it really helping a lot  ... just one thing i noticed if the text is string with number combined in it , the result will sum it too , as example if i have texts like ( "A2" , "5" , "2" ) the result will be "A - 9" instead of being "A2 - 7" ... is there code to adjust that in the lisp ? ... and really i thank u too much for ur help .. stay blessed 

(vl-load-com)
(defun c:countext ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt )
  (setq tot 0.0)
  (setq tagtxt "")
  (setq ans "")
  (setq texpression "=")
  (while (= ans "")
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq en (ssname ss (setq x (1- x))))
      (setq val (cdr (assoc 1 (entget en))))
      (if (= (wcmatch (strcase (vl-princ-to-string val)) "*A*,*B*,*C*,*D*,*E*,*F*,*G*,*H*,*I*,*J*,*K*,*L*,*M*,*N*,*O*,*P*,*Q*,*R*,*S*,*T*,*U*,*V*,*W*,*X*,*Y*,*Z*") nil) 
        (progn
          (setq val2 (LM:parsenumbers val))
          (setq val2len (length val2))
          (cond
            ((= val2len 0) 
              (if (= (strlen tagtxt) 0)
                (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
                (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
            ((= val2len 1)
              (setq tot (+ tot (car val2))) 
              (if (= (strlen texpression) 1)
                (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
                (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
            ((> val2len 1)
              (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ")
              (princ val2)
              (setq tot (+ tot (car val2)))       
              (if (= (strlen texpression) 1)
                (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
                (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
          );end of cond
        );end of progn
        (progn
          (if (= (strlen tagtxt) 0)
            (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
            (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
          )
          (vla-delete (vlax-ename->vla-object en))
        );end of progn
      );end of if
    );end of repeat
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  );end of while
  (princ "\n finished, result is = ")
  (princ tot)
  (princ "\n in expression = ")
  (princ texpression)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (setq resulttxt (strcat tagtxt " - " txt))
  (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)

(defun c:countext2 ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt )
  (setq tot 0.0)
  (setq tagtxt "")
  (setq ans "")
  (setq texpression "=")
  (while (= ans "")
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq en (ssname ss (setq x (1- x))))
      (setq val (cdr (assoc 1 (entget en))))
      (if (= (wcmatch (strcase (vl-princ-to-string val)) "*A*,*B*,*C*,*D*,*E*,*F*,*G*,*H*,*I*,*J*,*K*,*L*,*M*,*N*,*O*,*P*,*Q*,*R*,*S*,*T*,*U*,*V*,*W*,*X*,*Y*,*Z*") nil) 
        (progn
          (setq val2 (LM:parsenumbers val))
          (setq val2len (length val2))
          (cond
            ((= val2len 0) 
              (if (= (strlen tagtxt) 0)
                (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
                (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
            ((= val2len 1)
              (setq tot (+ tot (car val2))) 
              (if (= (strlen texpression) 1)
                (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
                (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
            ((> val2len 1)
              (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ")
              (princ val2)
              (setq tot (+ tot (car val2)))       
              (if (= (strlen texpression) 1)
                (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
                (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
          );end of cond
        );end of progn
        (progn
          (if (= (strlen tagtxt) 0)
            (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
            (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
          )
          (vla-delete (vlax-ename->vla-object en))
        );end of progn
      );end of if
    );end of repeat
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  )  
  (princ "\n finished, result is = ")
  (princ tot)
  (princ "\n in expression ")
  (princ texpression)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (setq resulttxt (strcat tagtxt " - " txt))
  (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (rh:em_txt (list (car pt) (- (cadr pt) (* 2 (cdr (assoc 40 el)))) (caddr pt)) texpression (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)


(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun


;; Parse Numbers  -  Lee Mac
;; Parses a list of numerical values from a supplied string.

(defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list str)
    )
)

 

in that case, you can use BIGAL's above code like this

 

 

the code is dirty because I was less awake 

and wrote the if and repeat in reverse and modified other parts, but it will work as expected.haha

Edited July 5, 2022 by exceed
edit typo

[shadi]

17 hours ago, exceed said:

(vl-load-com)
(defun c:countext ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt )
  (setq tot 0.0)
  (setq tagtxt "")
  (setq ans "")
  (setq texpression "=")
  (while (= ans "")
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq en (ssname ss (setq x (1- x))))
      (setq val (cdr (assoc 1 (entget en))))
      (if (= (wcmatch (strcase (vl-princ-to-string val)) "*A*,*B*,*C*,*D*,*E*,*F*,*G*,*H*,*I*,*J*,*K*,*L*,*M*,*N*,*O*,*P*,*Q*,*R*,*S*,*T*,*U*,*V*,*W*,*X*,*Y*,*Z*") nil) 
        (progn
          (setq val2 (LM:parsenumbers val))
          (setq val2len (length val2))
          (cond
            ((= val2len 0) 
              (if (= (strlen tagtxt) 0)
                (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
                (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
            ((= val2len 1)
              (setq tot (+ tot (car val2))) 
              (if (= (strlen texpression) 1)
                (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
                (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
            ((> val2len 1)
              (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ")
              (princ val2)
              (setq tot (+ tot (car val2)))       
              (if (= (strlen texpression) 1)
                (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
                (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
          );end of cond
        );end of progn
        (progn
          (if (= (strlen tagtxt) 0)
            (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
            (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
          )
          (vla-delete (vlax-ename->vla-object en))
        );end of progn
      );end of if
    );end of repeat
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  );end of while
  (princ "\n finished, result is = ")
  (princ tot)
  (princ "\n in expression = ")
  (princ texpression)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (setq resulttxt (strcat tagtxt " - " txt))
  (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)

(defun c:countext2 ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt )
  (setq tot 0.0)
  (setq tagtxt "")
  (setq ans "")
  (setq texpression "=")
  (while (= ans "")
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (setq el (entget (ssname ss 0)))
    (repeat (setq x (sslength ss))
      (setq en (ssname ss (setq x (1- x))))
      (setq val (cdr (assoc 1 (entget en))))
      (if (= (wcmatch (strcase (vl-princ-to-string val)) "*A*,*B*,*C*,*D*,*E*,*F*,*G*,*H*,*I*,*J*,*K*,*L*,*M*,*N*,*O*,*P*,*Q*,*R*,*S*,*T*,*U*,*V*,*W*,*X*,*Y*,*Z*") nil) 
        (progn
          (setq val2 (LM:parsenumbers val))
          (setq val2len (length val2))
          (cond
            ((= val2len 0) 
              (if (= (strlen tagtxt) 0)
                (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
                (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
            ((= val2len 1)
              (setq tot (+ tot (car val2))) 
              (if (= (strlen texpression) 1)
                (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
                (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
            ((> val2len 1)
              (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ")
              (princ val2)
              (setq tot (+ tot (car val2)))       
              (if (= (strlen texpression) 1)
                (setq texpression (strcat texpression (vl-princ-to-string (car val2))))
                (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2))))
              )
              (vla-delete (vlax-ename->vla-object en))
            )
          );end of cond
        );end of progn
        (progn
          (if (= (strlen tagtxt) 0)
            (setq tagtxt (strcat tagtxt (vl-princ-to-string val)))
            (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val)))
          )
          (vla-delete (vlax-ename->vla-object en))
        );end of progn
      );end of if
    );end of repeat
    (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>"))
  )  
  (princ "\n finished, result is = ")
  (princ tot)
  (princ "\n in expression ")
  (princ texpression)

  (setq pt (getpoint "\nSelect Total Insertion Point : "))
  (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)))
  (setq resulttxt (strcat tagtxt " - " txt))
  (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (rh:em_txt (list (car pt) (- (cadr pt) (* 2 (cdr (assoc 40 el)))) (caddr pt)) texpression (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) )
  (princ)
)


(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun


;; Parse Numbers  -  Lee Mac
;; Parses a list of numerical values from a supplied string.

(defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list str)
    )
)

 

in that case, you can use BIGAL's above code like this

 

 

the code is dirty because I was less awake 

and wrote the if and repeat in reverse and modified other parts, but it will work as expected.haha

reallly i cannt have words to thank u  , this is awesome perfect for me ...this is typically what i want  , thank u once again mr survivor