For each texts with the same coordinate keep the lowest value and delete the other

[Engineer_Yasser]

 

Please , I Need to overkill texts in layer "Level" that have the same coordinate

( For each texts with the same coordinate keep the lowest value and delete the other )

[Engineer_Yasser]

(defun c:DeleteDuplicates ()
  (setq layername "Level")
  (setq textdata (ssget "_X" (list (cons 0 "TEXT")(cons 8 layername))))
  (if textdata
    (progn
      (setq textlist '())
      (setq textcoords '())
      (setq deleted (list))
      (setq kept (list))
      
	  
	    (repeat (sslength textdata)
			(setq textobj (ssname pointEnts 0))
			(setq textcoord (cdr (assoc 10 (entget textobj))))
			(setq textcoords (cons textcoord textcoords))
			(setq textvalue (cdr (assoc 1 (entget textobj))))
			(setq textdata (ssdel textobj textdata))
		)
			
			
      (repeat (sslength textdata)
        (setq textobj (vlax-ename->vla-object (ssname textdata 0)))
        (setq textcoord (vlax-get-property textobj 'InsertionPoint))
        (setq textvalue (vla-get-textstring textobj))
		(setq textcoords (cons textcoord textcoords))
        
        (if (member textcoord textcoords)
            (setq deleted (cons textvalue deleted))
          (progn
            (setq textlist (cons textvalue textlist))
            
            (setq kept (cons textvalue kept))
          )
        )
        (setq textdata (ssdel (ssname textdata 0) textdata))
      )
	              (vla-delete deleted) ; Delete the duplicate text object
      
      (prompt (strcat "Deleted texts: " (apply 'strcat (reverse deleted)) "\n"))
      (prompt (strcat "Kept texts: " (apply 'strcat (reverse kept))))
    )
    (prompt "No texts found on the specified layer.")
  )
  (princ)
)

 

I found these codes but error, not working

[Engineer_Yasser]

(defun c:DeleteDuplicateTexts (/ ss texts coordinates lowest-text)
  (setq ss (ssget "_X" '((0 . "TEXT"))))
  (if (not ss)
    (progn
      (princ "\nNo texts found.")
      (princ)
    )
    (progn
      ;; Get all the texts and their coordinates
      (setq texts '())
      (setq coordinates '())
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (entget (ssname ss i)))
        (setq text (cdr (assoc 1 ent)))
        (setq coord (cdr (assoc 10 ent)))
        (setq texts (cons text texts))
        (setq coordinates (cons coord coordinates))
        (setq i (1+ i))
      )

      ;; Find and delete duplicate texts
      (setq i 0)
      (while (< i (length texts))
        (setq text (nth i texts))
        (setq coord (nth i coordinates))

        ;; Check if there are any other texts with the same coordinate
        (setq j (1+ i))
        ;(setq duplicate-indices '())
        (while (< j (length texts))
          (setq next-text (nth j texts))
          (setq next-coord (nth j coordinates))
          (if (and (equal coord next-coord)
                   ;(not (member j duplicate-indices))
                   (not (equal text next-text)))
            (progn
              ;(setq duplicate-indices (cons j duplicate-indices))
              (setq lowest-value (cdr (assoc 1 (entget (ssname ss i)))))
              (setq k (1+ j))
              (while (< k (length texts))
                (setq subsequent-text (nth k texts))
                (setq subsequent-coord (nth k coordinates))
                (if (and (equal coord subsequent-coord)
                         ;(not (member k duplicate-indices))
                         (not (equal text subsequent-text))
                         (< (cdr (assoc 1 (entget (ssname ss k)))) lowest-value))
                  (progn
                    (setq lowest-value (cdr (assoc 1 (entget (ssname ss k)))))
                    (setq j k)
                  )
                )
                (setq k (1+ k))
              )
            )
          )
          (setq j (1+ j))
        )

        ;; Delete texts with the same coordinate but different values
        (setq k 0)
        (while (< k (sslength ss))
          (setq ent (entget (ssname ss k)))
          (setq ent-coord (cdr (assoc 10 ent)))
          (setq ent-value (cdr (assoc 1 ent)))
          (if (and (= coord ent-coord)
                   (not (equal i k))
                   ;(not (member k duplicate-indices))
                   (not (= ent-value lowest-value)))
            (progn
              (entdel (ssname ss k))
              (setq ss (ssdel (ssname ss k) ss))
              (setq k (1- k))
            )
          )
          (setq k (1+ k))
        )

        (setq i (1+ i))
      )

      (princ "\nDuplicate texts deleted.")
      (princ)
    )
  )
)

 

I found these codes but error, not working .. Any help ?

 

[BIGAL]

When you post a request a good idea is post a sample dwg as we can test your code with it.

 

If the code is faulty ie use VLIDE or VS or Blade for Bricscad, it will display errors before you even run it. Obvious stuff like missing brackets.

 

Edited September 29, 2023 by BIGAL

[Engineer_Yasser]

7 hours ago, BIGAL said:

When you post a request a good idea is post a sample dwg as we can test your code with it.

 

If the code is faulty ie use VLIDE or VS or Blade for Bricscad, it will display errors before you even run it. Obvious stuff like missing brackets.

 

 

Ok .. i will consider attaching a sample file .. Thanks for advice