replace multiple text with others in order

[khaledabulazm]

Hi,

 

I'm struggling to find lisp that can save multiple text and allow me to change them in order of saving into other texts.

Attached some pictures to aid.

Any idea how this can be done?

Thanks in advance!

[Steven P]

How do you want this to work? 

 

For example, Lee Mac has a copy and swap text routine (ctx and stx) where in this case you can select the texts one at a time and where to copy that value to. This is a good LISP. So for example you would select '1' above then 'X', then '2' then 'X' and so on to copy into where you want them to go to

 

(http://lee-mac.com/copytext.html)

 

For things like this I prefer this 1-1 approach, select original text, select text to change.

 

It is possible to use selection sets to select the 2 sets of text, again my preference here is to select each text is turn, then move on to pasting them in turn, using a window to select all the texts can give unexpected results in my experience.

 

[mhupp]

Your wanting to select the top row or group of text? then get asked what text to change to "1", what text to change to "2" ... that you pick with the mouse?

[khaledabulazm]

14 minutes ago, Steven P said:

How do you want this to work? 

 

For example, Lee Mac has a copy and swap text routine (ctx and stx) where in this case you can select the texts one at a time and where to copy that value to. This is a good LISP. So for example you would select '1' above then 'X', then '2' then 'X' and so on to copy into where you want them to go to

 

(http://lee-mac.com/copytext.html)

 

For things like this I prefer this 1-1 approach, select original text, select text to change.

 

It is possible to use selection sets to select the 2 sets of text, again my preference here is to select each text is turn, then move on to pasting them in turn, using a window to select all the texts can give unexpected results in my experience.

 

Thanks steven for your response.

 

I have tried Lee Mac's lisp, but it hasn't what i am looking for.

The texts that need to be changed is not in one place, so i have to zoom in and out a lot.

[khaledabulazm]

Just now, mhupp said:

Your wanting to select the top row or group of text? then get asked what text to change to "1", what text to change to "2" ... that you pick with the mouse?

What I am looking for is to select group of texts in my order same as "TCount" routine and be able to replace another group of text according to what i select from them in same order of first selection.

If I get asked what text to change to "1", what text to change to "2", that would be a plus.

 

Thanks a lot for your reply.

[Steven P]

Yes, this is possible,

 

I think if you select all the first texts, either with a box or one after another, you can extract the text string from each (saved as a list), then taking that list update the new text string with that value in the order that you want. Doing it that way, you can select all the texts in one part of the drawing and then scroll to the new part to update the texts.

 

How are your LISP abilities by the way, if we gave you fairly subtle hints would you be able to work it out or would you want something more complete? I know some people enjoy working it out after a few tips, some don't.

 

I'll see if I can put something together later, should have some copy and paste stuff that I think might work

[mhupp]

This is what i use to copy text to another text. tho it doesn't allow you to select multiple to copy.

https://autocadtips1.com/2012/02/27/autolisp-copy-text-to-table-cells/

[Steven P]

Here is another option, copy and pasted from what I have, not perfect though

 

 

(defun c:MSCTX ( / MySS MySS2 acount entcodes ent1 ent2 entlist1 entlist2 text01
                  text02 text11 text12 entcodes1 entcodes2 acount acounter explist
               )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun deletelistitem (mylist itemtodelete / acounter nextitem)
;;delete a list item
  (setq acounter 0)
  (while (< acounter (length mylist) )
    (setq nextitem (car mylist))
    (setq mylist (cdr mylist)) ;;chop off first element
    (if (/= nextitem itemtodelete)
      (progn
        (setq mylist (append mylist (list nextitem))) ;stick next item to the back
      );end progn
    );end if
    (setq acounter (+ acounter 1))
  );end while
  (setq nextitem (car mylist))
  (setq mylist (cdr mylist))
  (setq mylist (append mylist (list nextitem)))
  mylist
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun deletedxfdata ( delent delentlist entcodes / acount acounter )
  (setq acounter 0)
  (setq acount 0)
  (while (< acount (length entcodes))
    (while (< acounter (length delentlist))
      (if (= (car (nth acounter delentlist) ) (nth acount entcodes) )
        (progn
          (entmod (setq delentlist (subst (cons (nth acount entcodes) "") (nth acounter delentlist) delentlist)))
          (entupd delent)
        )
      )
      (setq acounter (+ acounter 1))
    );end while
   (setq acount (+ acount 1))
  );end while
  delentlist
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext)
;;get dotted pairs list
  (setq entlist (entget ent))
  (setq enttype (cdr (assoc 0 entlist)))
  (setq acount 0)
  (while (< acount (length entlist))
    (setq acounter 0)
    (while (< acounter (length entcodes))
      (setq entcode (nth acounter entcodes))
      (if (= (car (nth acount entlist)) entcode )
        (progn
          (setq newtext (cdr (nth acount entlist)))
          (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers
          (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) )
        );end progn
      );end if
      (setq acounter (+ acounter 1))
    );end while
    (setq acount (+ acount 1))
  );end while
;;get string from dotted pair lists
  (if (= listorstring "astring") ;convert to text
    (progn
      (if (> (length mytext) 0)
        (progn
          (setq acount 0)
          (setq temptext "")
          (while (< acount (length mytext))
            (setq temptext (cdr (nth acount mytext)) )
            (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text
            (if (= stringtext nil)
              (setq stringtext temptext)
              (setq stringtext (strcat stringtext temptext ))
            );end if
            (setq acount (+ acount 1))
          );end while
        );end progn
      );end if
      (if (= stringtext nil)(setq stringtext ""))
      (setq mytext stringtext)
    );end progn
  );end if
  mytext
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;get text as a string
(defun gettextasstring ( enta entcodes / texta )
  (if (= (getfroment enta "astring" entcodes) "")
    ()
    (setq texta (getfroment enta "astring" entcodes))
  )
  texta
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun addinnewtext (newtext newentlist newent / )
  (if (/= newtext nil)
    (progn
      (if (= (cdr (assoc 0 newentlist)) "DIMENSION") 
        (progn
;;ent mod method, stops working at 2000-ish characters
          (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist)))
          (entupd newent)
        );end progn

        (progn
;;vla-put-text string for large text blocks + 2000 characters?
          (vla-put-textstring (vlax-ename->vla-object newent) newtext)
        );end progn
      ) ;end if
    ) ;end progn
    (princ "\nSource text is not 'text'")
  );end if
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:MSCTX ( / MySS MySS2 acount entcodes ent1 ent2 entlist1 entlist2 text01
                  text02 text11 text12 entcodes1 entcodes2 acount acounter explist
               )
;;get text 1
  (setq MySS (ssget '((0 . "*TEXT"))))
  (setq acount 0)
  (while (< acount (sslength MySS))
    (setq ent1 (ssname MySS acount))
    (setq entlist1 (entget ent1))
    (setq entcodes1 (list 3 4 1 172 304) )
    (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string

    (princ (strcat "\nSelect Text to change to " text01 " or press ENTER to move on: "))
;;loop till cancelled
    (while (/=  nil (setq MySS2 (ssget "_:S" '((0 . "*TEXT")))))
      (setq ent2 (ssname MySS2 0 ))

;;get text 2
      (setq entlist2 (entget ent2))
      (setq entcodes2 (list 3 4 1 172 304) )
      (setq text02 (gettextasstring ent2 entcodes2) )
      (setq entcodes2 (deletelistitem entcodes2 '1))
      (setq entlist2 (deletedxfdata ent2 entlist2 entcodes2))

;;put in new text
      (addinnewtext text01 entlist2 ent2)
      (princ (strcat "\nSelect Text to change to " text01 " or press ENTER to move on: "))
    );end while
    (setq acount (+ acount 1))
  )
  (princ)
)

 

Edited July 26, 2022 by Steven P

[BIGAL]

My $0.05 just ssget text, then make a list as suggested maybe sort the list so always 1 2 3 4 then just use a while/repeat/foreach  select destination text it will update as 1 2 3 4. This is very rough maybe needs sort and a proper exit when pick less than selection set.

 

(defun c:mattext ( / ss lst x ent)
(setq ss (ssget '((0 . "TEXT"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq lst (cons (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))) lst))
)
(setq lst (reverse lst))
(setq x -1)
(repeat (length lst)
(setq ent (entget (car (entsel "\nPick text "))))
(entmod (subst (cons 1 (nth (setq x (1+ x)) lst)) (assoc 1 ent) ent))
)
(princ)
)

 

[khaledabulazm]

On 7/27/2022 at 3:38 AM, BIGAL said:

My $0.05 just ssget text, then make a list as suggested maybe sort the list so always 1 2 3 4 then just use a while/repeat/foreach  select destination text it will update as 1 2 3 4. This is very rough maybe needs sort and a proper exit when pick less than selection set.

 

(defun c:mattext ( / ss lst x ent)
(setq ss (ssget '((0 . "TEXT"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq lst (cons (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))) lst))
)
(setq lst (reverse lst))
(setq x -1)
(repeat (length lst)
(setq ent (entget (car (entsel "\nPick text "))))
(entmod (subst (cons 1 (nth (setq x (1+ x)) lst)) (assoc 1 ent) ent))
)
(princ)
)

 

 

Sorry for late respone, thanks sincerely for you reply and effort. 

It replaced te t in reverse order but did the trick anyway

Again sorry for my late reply

[BIGAL]

Reverse order try with this line removed.

 

(setq lst (reverse lst))

 

Have to go now so code not tested more.

 

[mhupp]

here is my take

You can select multiple text to copy. It will filter out duplicates.

Then sort them in an order (works best with numbers) and then ask what text to update with what its going to update to. right click to go to the next in the list.

 

Example

 

;;----------------------------------------------------------------------------;;
;; Select Multiple Text Update Multiple Text
(defun C:UMT (/ SS lst txt ent)
  (if (setq SS (ssget '((0 . "TEXT"))))
    (foreach txt (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq str (cdr (assoc 1 (entget txt))))
      (if (not (member str lst))
        (setq lst (cons str lst))
      )  
    )
  )
  (setq lst (vl-sort lst '<))
  (while (> (length lst) 0)
    (if (and (setq txt (car (entsel (strcat "\nUpdate Text To: [" (car lst) "]")))) (eq (cdr (assoc 0 (setq x (entget txt)))) "TEXT"))
      (progn
        (entmod (subst (cons 1 (car lst)) (assoc 1 x) x))
        ;(setq lst (cdr lst)) ;uncomment if you only want to go to the next item on the list if successful, no multiple selections like #1 example.
      )        
      (setq lst (cdr lst))
    )
  )
  (princ)
)

 

[khaledabulazm]

On 12/1/2022 at 11:55 PM, BIGAL said:

Reverse order try with this line removed.

 

(setq lst (reverse lst))

 

Have to go now so code not tested more.

 

Thank you for your quick response

Worked like charm.

Again thank you for your time and effort

[khaledabulazm]

On 12/2/2022 at 5:13 AM, mhupp said:

here is my take

You can select multiple text to copy. It will filter out duplicates.

Then sort them in an order (works best with numbers) and then ask what text to update with what its going to update to. right click to go to the next in the list.

 

Example

 

;;----------------------------------------------------------------------------;;
;; Select Multiple Text Update Multiple Text
(defun C:UMT (/ SS lst txt ent)
  (if (setq SS (ssget '((0 . "TEXT"))))
    (foreach txt (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq str (cdr (assoc 1 (entget txt))))
      (if (not (member str lst))
        (setq lst (cons str lst))
      )  
    )
  )
  (setq lst (vl-sort lst '<))
  (while (> (length lst) 0)
    (if (and (setq txt (car (entsel (strcat "\nUpdate Text To: [" (car lst) "]")))) (eq (cdr (assoc 0 (setq x (entget txt)))) "TEXT"))
      (progn
        (entmod (subst (cons 1 (car lst)) (assoc 1 x) x))
        ;(setq lst (cdr lst)) ;uncomment if you only want to go to the next item on the list if successful, no multiple selections like #1 example.
      )        
      (setq lst (cdr lst))
    )
  )
  (princ)
)

 

Thanks for your response

Worked fine for your proposal