Jump to content

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

shadi

By shadi
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

shadi Contributor

shadi

Posted
Posted

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

 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

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)

 

  • Like 2
  • Agree 1
Link to comment
Share on other sites
shadi Contributor

shadi

Posted
  • Author
Posted
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 🙏

Link to comment
Share on other sites
exceed Rising Star

exceed

Posted
Posted (edited)
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 by exceed
  • Like 1
  • Agree 1
Link to comment
Share on other sites
shadi Contributor

shadi

Posted
  • Author
Posted (edited)
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 by shadi
Link to comment
Share on other sites
tombu Veteran

tombu

Posted
Posted

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.

  • Agree 1
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 by BIGAL
  • Confused 1
Link to comment
Share on other sites
shadi Contributor

shadi

Posted
  • Author
Posted
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 🙏

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 by BIGAL
  • Like 1
Link to comment
Share on other sites
shadi Contributor

shadi

Posted
  • Author
Posted (edited)
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 by shadi
Link to comment
Share on other sites
tombu Veteran

tombu

Posted
Posted
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.

  • Like 1
Link to comment
Share on other sites
shadi Contributor

shadi

Posted
  • Author
Posted
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 

 

Link to comment
Share on other sites
exceed Rising Star

exceed

Posted
Posted
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 

 

 

 

 

countext3.gif

 

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

  • Like 2
  • Thanks 1
Link to comment
Share on other sites
shadi Contributor

shadi

Posted
  • Author
Posted
20 hours ago, exceed said:

 

countext3.gif

 

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 🙏😇

Link to comment
Share on other sites
exceed Rising Star

exceed

Posted
Posted (edited)
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 by exceed
edit typo
  • Thanks 1
Link to comment
Share on other sites
shadi Contributor

shadi

Posted
  • Author
Posted
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 💐🙏

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...