DELETE TEXTS WITH SAME CONTENT

[Mirsh]

Hi Dears ;

I Appreciate if you help me for quick code for removing selection texts with same content and remain just one text per content .

thanks.

[dan20047]

overkill?

[pBe]

 

And the one to remain is the TEXT/MTEXT as selected for reference? Because that makes more sense so the program would know what to keep.

(defun c:KillemaLL (/ a o ss)
  (if (and
	(setq a (car (nentsel "\nSelect Text string: ")))
	(setq o	(member	(Cdr (assoc 0 (setq ent (entget a))))
			'("TEXT" "MTEXT")
		)
	)
	(setq s
	       (ssget "_X" (mapcar '(lambda (d) (assoc d ent)) '(0 1 410)))
	)
      )
    (command "_erase" (ssdel a s) "")
  )
)

 

 

[Mirsh]

Thanks PBE ; your code works nice

but how could do this with selectionset (not in all drawing) ; like select thousands text and it keeps just one text per content and remove the rests

[pBe]

Remove the "_X" at the ssget line. 

 

[Steven P]

can't remember where I got this from, all credits should go there of course.

 

This should delete duplicate text objects (text on top of identical text) but will leave alone if the text is at different coordinates.

(defun c:txtdeldup( / ss ssdup ct len e eb pt lay ang sty hgt str obj obj_list)

(princ "\nSelect text objects.") ;Select objects and filter all but block insert objects.
(setq ss (ssget (list (cons 0 "TEXT"))))
(if ss ;If any valid objects were selected.
(progn
(princ "\nBuilding list of objects.")
(setq ssdup (ssadd)) ;Initialize new selection set to hold objects to delete
(setq len (sslength ss)) ;Find out how many objects were selected.
(setq ct 0)
(while (< ct len) ;Loop through selected objects
(setq e (ssname ss ct)) ;Get an object name
(setq eb (entget e)) ;Get the entity list from the object name
(setq ct (+ ct 1)) ;Increment index into selection set
(setq pt (cdr (assoc 10 eb))) ;Access object's coordinate
(setq lay (cdr (assoc 8 eb))) ;Access object's layer
(setq ang (cdr (assoc 50 eb))) ;Access object's rotation angle
(setq sty (cdr (assoc 7 eb))) ;Access object's text style
(setq hgt (cdr (assoc 40 eb))) ;Access object's text height
(setq str (cdr (assoc 1 eb))) ;Access object's text string
;Make list of object properties

;(setq obj (list pt lay ang sty hgt str))
(setq obj (list pt str))
(if (not (member obj obj_list)) ;If these properties are not already in list
(setq obj_list (cons obj obj_list)) ;Add them to the list
(ssadd e ssdup) ;Else add object to selection set to delete
) ;End if
) ;End of while loop

(if (> (sslength ssdup) 0) ;If there are any objects in the selection set to delete
(progn
(princ "\nDeleting duplicate objects.")
(setq len (sslength ssdup)) ;Find out how many many objects to delete.
(setq ct 0)
(while (< ct len) ;Loop through objects and delete.
(setq e (ssname ssdup ct)) ;Get object name
(setq ct (+ ct 1)) ;Increment index into selection set
(entdel e) ;Delete duplicate object
) ;End of while loop

 ;Print the number of objects deleted to command line
(princ (strcat "\nDeleted " (itoa len) " duplicate objects." ))
) ;End progn
(princ "\nNo duplicates found.") ;Else no there were no duplicates to delete.
) ;End if

) ;End progn
(princ "\nNo text objects selected.") ;Else there were no valid objects selected
) ;End if
(princ)
)

 

[Mirsh]

pbe

your code select a unique text and operate ;  but i need a code that search the selectionset of texts and automatically remove texts with same contents except one of them.

 

[Mirsh]

Thank for your attention steven ; but that's not my intention

[pBe]

2 hours ago, Mirsh said:

pbe

your code select a unique text and operate ;  but i need a code that search the selectionset of texts and automatically remove texts with same contents except one of them.

 

I know that, but how would the program know what among the selection of the same value  will remain? Will it be the one from the left? On the right? Understand what i mean?

Say there are 20 TEXT with the value of "ABC", which of the 20 will not be deleted ?  better yet, post a sample drawing.

What you're asking is not that difficult. but what are the conditions? why the particular "ABC" at coordinates 2.0,5.0,0 is the one to remain and 19 of them deleted? why not the one on 5.0,26.0,0.0 ?

 

(defun c:WhodecidesWhoStayandWhoDies ()
  )

 

Edited February 23, 2021 by pBe

[Mirsh]

You are Right but it dos'nt matter at all just keep one per content;

wherever , thereover ,  hereunder , ...

[pBe]

1 hour ago, Mirsh said:

You are Right but it dos'nt matter at all just keep one per content;

wherever , thereover ,  hereunder , ...

(defun c:WhodecidesWhoStayandWhoDies (/ addtolist AllWhoDies ss i e)
"Dont need it"
)

 

 

Edited February 23, 2021 by pBe

[Mirsh]

Thank you for taking your time , dear PBE 

[Mirsh]

Edited February 23, 2021 by Mirsh

[pBe]

So how did it go?

 

And what are those needs? Is it so hard to post a sample drawing of before and after so we can move on.

Edited February 23, 2021 by pBe

[Mirsh]

 you SPEND much time dear

I'll see what i can do with your above codes they're most near to my need.

Edited February 23, 2021 by Mirsh

[Lee Mac]

Some good examples pBe

 

Here's another method which avoids the double iteration (since we don't care which text object is removed):

(defun c:delduptxt ( / e i l s v )
    (if (setq s (ssget "_:L" '((0 . "TEXT"))))
        (repeat (setq i (sslength s))
            (setq i (1- i)
                  e (ssname s i)
                  v (cdr (assoc 1 (entget e)))
            )
            (if (member v l) (entdel e) (setq l (cons v l)))
        )
    )
    (princ)
)

 

 

[pBe]

17 minutes ago, Lee Mac said:

Here's another method which avoids the double iteration (since we don't care which text object is removed):

 

That make sense given the OP has all but given up on setting a criteria for who dies and who gets to live another day. 

 

I was still hoping that the OP will come to his senses and realize what i'm trying to say all along.

 

Edited February 23, 2021 by pBe

[Mirsh]

Hi lee ; that's right PBE Examples are very good and i didt have face to take more time of him ; but your code is exact and thanks you

Edited February 23, 2021 by Mirsh

[3dwannab]

On 2/23/2021 at 6:38 PM, Lee Mac said:

Some good examples pBe

 

Here's another method which avoids the double iteration (since we don't care which text object is removed):

(defun c:delduptxt ( / e i l s v )
    (if (setq s (ssget "_:L" '((0 . "TEXT"))))
        (repeat (setq i (sslength s))
            (setq i (1- i)
                  e (ssname s i)
                  v (cdr (assoc 1 (entget e)))
            )
            (if (member v l) (entdel e) (setq l (cons v l)))
        )
    )
    (princ)
)

 

 

 

 

 Thanks Lee, I hope you don't mind. I have added MTEXT and MULTILEADER entities to your code.

 

;; Modification of Lee Mac code here to delete duplicate TEXT to include MTEXT and MULTILEADER's by 3dwannab on 2024.01.30.

(defun c:--LDDelDupText (/) (progn (LOAD "DelDupText") (c:DelDupText)))

(defun c:DelDupText (/ *error* acDoc e i l s v) 

  (vl-load-com)

  (defun *error* (errmsg) 
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg 
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq s (ssget "_:L" '((0 . "MULTILEADER,*TEXT"))))

  (if s 
    (repeat (setq i (sslength s)) 
      (setq i (1- i)
            e (ssname s i)
      )

      (if (= (cdr (assoc 0 (entget (ssname s i)))) "MULTILEADER") 
        (setq v (cdr (assoc 304 (entget e)))) ;; MULTILEADER
        (setq v (cdr (assoc 1 (entget e)))) ;; TEXT and MTEXT
      )

      (if (member v l) (entdel e) (setq l (cons v l)))
    )
  )

  (*error* nil)
  (princ)
)