Copy multiple text contents to nearest text (multiples)

[Isaac26a]

Hi everyone, I'd like to ask if you know a way to copy the contents of the text in yellow to the texts in gray in a simple way, or do you have any ideas to work around it, thanks for taking your time.

 

sample.dwg

Edited November 21, 2021 by Isaac26a

[BIGAL]

It appears that in image the 2 text overlap so it should be easy you get a selection set of one of the texts say yellow, then look for another text at that location, if found update the grey text. It would be a lisp. 

[Isaac26a]

In many of them you could say they overlap, but not in all of them, how can I search for a text in 'lets say a radius of 0.3'?, so far If I understand right 

1. I should make a selection set of the texts in yellow (different layer and color, so should not be a problem)

2. Make a selection set of the texts in gray (so far ok)

How can I search for each one of the texts in gray from every insertion point of the texts in yellow?, then copying and replacing text wouldn't be much of a problem, and make the loop.

[dan20047]

If you don't mind manually picking source & destination, try this:

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

[Isaac26a]

16 minutes ago, dan20047 said:

If you don't mind manually picking source & destination, try this:

Thanks dan20047, but I don't see how this can help me, I actually do it kind of manually, (created a lisp) to pick one by one, pick the source and pick the destination and the destination text is replaced by the source text, but it takes time.

Still working on the lisp to achieve it, if I have it soon I'll post it so you (all) can help me make it faster, thanks.

 

By the way a question, I started with this:

   (princ "\nSelect a text with the source data: \n")
   (while (not (setq stx1 (ssget ":S:E" '((0 . "*TEXT")))))
      (princ "\nSelect a text with the source data: \n")
   )
   (setq lyr1 (cdr (assoc 8 (entget (ssname stx1 0)))))
   (princ "\nSelect a text in the destination layer: \n")
   (while (not (setq stx2 (ssget ":S:E" '((0 . "*TEXT")))))
      (princ "\nSelect a text in the destination layer: \n")
   )
   (setq lyr2 (cdr (assoc 8 (entget (ssname stx2 0)))))
   (setq ss1 (ssget "_X" '((0 . "TEXT") (8 . "cvl_ras_tx")))  	;;; (cons 8 lyr1)

And wanted to make the ss1 picking the entity but 

(setq ss1 (ssget "_X" '((0 . "TEXT") (8 . lyr1))))

wouldn't work so had to do it (8 . "cvl_ras_tx"), and then it worked, why is that?, as you see I tried (cons 8 lyr1) but neither worked

[dan20047]

11 minutes ago, Isaac26a said:

 

(setq ss1 (ssget "_X" '((0 . "TEXT") (8 . lyr1))))

wouldn't work so had to do it (8 . "cvl_ras_tx"), and then it worked, why is that?, as you see I tried (cons 8 lyr1) but neither worked

It works with list instead of quote because you want to evaluate the data

(setq ss1 (ssget "_X" (list '(0 . "TEXT") (cons 8 lyr1))))

 

see http://www.lee-mac.com/quote.html for explanation

[Isaac26a]

25 minutes ago, dan20047 said:

It works with list instead of quote because you want to evaluate the data

Thanks for the explanation and the reference. dan20047

[Steven P]

1 hour ago, Isaac26a said:

Thanks dan20047, but I don't see how this can help me, I actually do it kind of manually, (created a lisp) to pick one by one, pick the source and pick the destination and the destination text is replaced by the source text, but it takes time.

Still working on the lisp to achieve it, if I have it soon I'll post it so you (all) can help me make it faster, thanks.

 

If you are manually picking source then destination, you could try this from Lee Mac. http://lee-mac.com/copytext.html

 

[Isaac26a]

Thanks Steven, finally finished my lisp and it's working, now does anyone have a better idea to improve it?

;;; By Isaac A.
;;; Select multiples texts and copy their content to nearest texts
;;; https://www.cadtutor.net/forum/topic/74035-copy-multiple-text-contents-to-nearest-text-multiples/

(defun c:cmt (/ cnt1 cnt2 dist ent1 ent2 ss1 ss2 stx1 stx2 tx1 tx2 lyr1 lyr2)
   (setvar "cmdecho" 0)
   (vl-cmdf "_.undo" "_begin")
   (setq *osmode (getvar "osmode"))
  
   (setvar "osmode" 0)
   (setq ss1 (ssget "_X" '((0 . "TEXT") (8 . "cvl_ras_tx")))
         ss2 (ssget "_X" '((0 . "TEXT") (8 . "urb_rasante")))
   )
   (setq cnt1 0)
   (while (< cnt1 (sslength ss1))
      (if (/= nil (assoc 11 (entget (ssname ss1 cnt1))))
         (setq pt1 (cdr (assoc 11 (entget (ssname ss1 cnt1))))
               cnt2 0
	       ent1 (entget (ssname ss1 cnt1))
               tx1 (assoc 1 ent1)
               dist 2
         )
         (setq pt1 (cdr (assoc 10 (entget (ssname ss1 cnt1))))
               cnt2 0
	       ent1 (entget (ssname ss1 cnt1))
               tx1 (assoc 1 ent1)
               dist 2
         )
      )
      (while (< cnt2 (sslength ss2))
         (if (/= nil (assoc 11 (entget (ssname ss2 cnt2))))
            (setq pt2 (cdr (assoc 11 (entget (ssname ss2 cnt2))))
            )
            (setq pt2 (cdr (assoc 10 (entget (ssname ss2 cnt2))))
            )
         )
	 (if (< (distance pt1 pt2) dist)
            (progn
               (setq dist (distance pt1 pt2)
                     ent2 (entget (ssname ss2 cnt2))
                     tx2 (assoc 1 ent2)
               )
	       (entmod (subst tx1 tx2 ent2))
            )
         )
         (setq cnt2 (1+ cnt2))
      )
     
      (setq cnt1 (1+ cnt1))
   )

   (setvar "osmode" *osmode)
   (vl-cmdf "_.undo" "_end")
   (princ) 
)

 

[BIGAL]

Another way is use the text pt and make a polygon can be just 4 sides a few more sides can work better, then get its co-ordinates, then erase (entlast) a simple (ssget "CP" co-ords (list (cons 0 "TEXT")(cons 8 layer))) this saves searching  through the other text selection set.

 

(command "ploygon" Pt "I" rad) 
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))
(command "erase" (entlast) "")
(setq ss (ssget "CP" co-ords (list (cons 0 "TEXT")(cons 8 layer))))

 

[Isaac26a]

51 minutes ago, BIGAL said:

Another way is use the text pt and make a polygon can be just 4 sides a few more sides can work better, then get its co-ordinates, then erase (entlast) a simple (ssget "CP" co-ords (list (cons 0 "TEXT")(cons 8 layer))) this saves searching  through the other text selection set.

 

Seems to be an interesting option, I wouldn't have imagined it, maybe I should try to test it on the benchmark lisp I saw the other day Ronjonp used, although I'm not sure how it works or if it works for a complete lisp, maybe the search through the selection set takes longer.

Thanks for your help Alan.

[mhupp]

23 hours ago, Isaac26a said:

does anyone have a better idea to improve it?

 

 

Here is what i came up with. Basically the same as yours except

using foreach function

looking at 72 to get the correct point.

Ignore distance. so if *dist = 25 but closest text is 35 it won't change

Removes changed text from selection set to speed up later searches.

removing text also speed up if their are more entity's in SS1 then SS2.

 

;;----------------------------------------------------------------------------;;
;; Select multiples texts and copy their content to nearest texts
(defun C:CMT (/ dist *dist PT1 PT2 ent ss1 ss2 obj)
  (setvar "cmdecho" 0)
  (vl-cmdf "_.undo" "_begin")
  (setq *osmode (getvar "osmode"))
  (setvar "osmode" 0)
  (setq SS1 (ssget "_X" '((0 . "TEXT") (8 . "cvl_ras_tx")))  ;copy
        SS2 (ssget "_X" '((0 . "TEXT") (8 . "urb_rasante"))) ;replace
  )
  (if SS1
    (foreach txt1 (mapcar 'cadr (ssnamex SS1))
      (if (= (cdr (assoc 72 (entget txt1))) 0)
        (setq PT1 (cdr (assoc 10 (entget txt1))))
        (setq PT1 (cdr (assoc 11 (entget txt1))))
      )
      (setq *dist 1000 ;change *dist value to ignore items farther away but still cloest item.
            ent nil    ;resets ent error checking if match is made.
      ) 
      (if (> (sslength SS2) 0)
        (progn
          (foreach txt2 (mapcar 'cadr (ssnamex SS2))
            (if (= (cdr (assoc 72 (entget txt2))) 0)
              (setq PT2 (cdr (assoc 10 (entget txt2))))
              (setq PT2 (cdr (assoc 11 (entget txt2))))
            )
            (setq dist (distance PT1 PT2))
            (if (< dist *dist)
              (progn
                (setq *dist dist)
                (setq ent txt2)
              )
            )
          )
          (if ent ;might not be any matches if beond ignore distance
            (progn
              (setq tx1 (assoc 1 (entget txt1)))
              (setq obj (entget ent))
              (entmod (subst tx1 (assoc 1 obj) obj))
              (ssdel ent SS2) ;removes changed text from selection set so later searches are faster
            )
          )
        )
      )
    )
  )
  (setvar "osmode" *osmode)
  (vl-cmdf "_.undo" "_end")
  (princ)
)

 

Edited November 21, 2021 by mhupp

[Tharwat]

You have many overlapping texts in many places so its better to overkill the duplicates.

(defun c:Test ( / int sel ent get ins txt src tar srt)
  ;; Tharwat - 21.Nov.2021	;;
  (and (setq int -1 sel (ssget "_:L" '((0 . "TEXT") (8 . "urb_rasante,CVL_RAS_TX"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (setq get (entget ent)
               ins (cdr (assoc 10 get))
               txt (cdr (assoc 01 get))
               )
         (or (and (= (cdr (assoc 8 get)) "CVL_RAS_TX")
                  (setq src (cons (list ins txt get) src))
                  )
             (setq tar (cons (list ins txt get) tar))
             )
         )
       (while (and src tar
                   (setq itm (car tar))
                   (setq srt (vl-sort src (function (lambda (j k) (< (distance (car itm) (car j))
                                                                     (distance (car itm) (car k)))
                                                      )
                                                    )
                                      )
                         )
                   (entmod (subst (cons 1 (cadar srt)) (assoc 1 (last itm)) (last itm)))
                   (setq tar (cdr tar)
                         src (cdr srt))
                   )
         )
       )
  (princ)
  ) (vl-load-com)

 

[Isaac26a]

Well I tested the programs in a much larger scale (about 1550) text for each selection set and the results were

Tharwat's took  0:16.27

Mine  took          2:50:15

Mhupp's gives me an ; error: too many arguments wich I couldn't find where it is, as I see it, has a better improvement than mine

Bigal's didn't knew how to adapt it, maybe I should keep studying lisp wich I will, but at the moment don't know how

 

20 hours ago, Tharwat said:

You have many overlapping texts in many places so its better to overkill the duplicates.

Yes, you're right I didn't see that before, but when I downloaded the sample again saw it, Although I tried overkill, I haven't checked but in my old 2010 C3d version overkill doesn't have an option for duplicated texts so it didn't work using it, have to see in my 2019 version if it does.

 

Thank you guys (Dan20047, Steven P, BigAl, Mhupp and Tharwat) for caring and helping.

Edited November 22, 2021 by Isaac26a

[mhupp]

4 hours ago, Isaac26a said:

Mhupp's gives me an ; error: too many arguments wich I couldn't find where it is, as I see it, has a better improvement that mine

 

Fat fingered it!

 

(if (> (sslength SS2 0))
to
(if (> (sslength SS2) 0)

 

[mhupp]

Looking over your code @Tharwat very nice. I will use this when comparing entity's from now on. I also saw something awhile back for entmod. When pulling the assoc # don't use cdr on them. makes it about 5-10% faster.

 

(setq get (entget ent)
      ins (cdr (assoc 10 get))
      txt (assoc 01 get)
)
....
(entmod (subst (cadr srt) (cadr itm) (last itm)))
(entmod (subst stxt ctxt get)) ;if they are not in a list



(setq get (entget ent)
      ins (cdr (assoc 10 get))
      txt (cdr (assoc 01 get))
)
....
(entmod (subst (cons 1 (cadar srt)) (assoc 1 (last itm)) (last itm)))

 

Edited November 21, 2021 by mhupp

[Isaac26a]

8 hours ago, mhupp said:

Fat fingered it!

Yes, Thanks for the correction, I tested your code with the correction, and It took 1:16.88 wich is almost half of the time that mine took, I'll study the mods both of you made, so I can apply it to other programs, and keep improving. Thanks again for your help.

[ronjonp]

Here is another way .. checks that there is something within a distance of 1.5 ( based on the sample drawing ). Should be fairly fast 

(defun c:foo (/ a b c d el r s)
  ;; RJP » 2021-11-22
  (cond	((setq s (ssget "_X" '((0 . "TEXT") (8 . "urb_rasante,CVL_RAS_TX"))))
	 (setq d 1.5)
	 (foreach e (mapcar 'cadr (ssnamex s))
	   (if (= "CVL_RAS_TX" (cdr (assoc 8 (setq el (entget e)))))
	     (setq a (cons (list (cdr (assoc 11 el)) (cdr (assoc 1 el))) a))
	     (setq b (cons (list (cdr (assoc 11 el)) e) b))
	   )
	 )
	 (setq a (vl-sort a '(lambda (r j) (< (caar r) (caar j)))))
	 (setq b (vl-sort b '(lambda (r j) (< (caar r) (caar j)))))
	 (while	(setq c (car a))
	   (setq a (cdr a))
	   (if (vl-some '(lambda (x) (<= (distance (car c) (car (setq r x))) d)) b)
	     (list (entmod (append (entget (cadr r)) (list (cons 1 (cadr c)))))
		   (setq b (vl-remove r b))
	     )
	     (entmake (list '(0 . "circle") (cons 10 (car c)) '(40 . 5) '(8 . "NoMatch")))
	   )
	 )
	)
  )
  (princ)
)

 

Edited November 22, 2021 by ronjonp

[Isaac26a]

25 minutes ago, ronjonp said:

Here is another way .. checks that there is something within a distance of 1.5 ( based on the sample drawing ). Should be fairly fast 

Thanks Ronjonp, another impresive code to study, in the same test sample the (1550 texts) it took 0:04.07 much more than fairly fast. Hats off to all of you guys, thanks.

[ronjonp]

10 minutes ago, Isaac26a said:

Thanks Ronjonp, another impresive code to study, in the same test sample the (1550 texts) it took 0:04.07 much more than fairly fast. Hats off to all of you guys, thanks.

Glad to help