Help - Select duplicate entities

[teknomatika]

Dear friends: It certainly is a routine that could be improved, but for now is to solve what I wanted.
However, in certain situations, does not seem to work. After calling the routine and selected entities, the layer "duplicates" is created but it gives an error function. Annex clip of the message.
I forgot to tell: In this error condition, the layer is created but duplicate entities are not detected.
What is the reason?

message_error.jpg

[pBe]

Strange.. the code is not even supposed to invoke the Layer command. whee did that come from?

EDIT: I see now, it gives that error if none found (the code doesnt include much errorr trapping in testing phase) perhaps enitites on locked layer?

Quick Fix:

 
(setq objs (ssget ":L" '((0 . "*LINE,ARC,CIRCLE"))))
....
(if (> (sslength Dupss) 1)
(command "_chprop"  objs "R" Dupss  "" "p" "Layer" "Duplicates" "") (princ "\nNo Duplicates Found:"))
(princ)
   )

You can add this to David's Code

 (ssdel en ss)) 
(if (setq i (sslength (setq objs (eval (read (strcat "S" e))))))
(repeat i
         (setq ent_e (entget (ssname objs (setq i (1- i)))))
                 (entmod (subst (cons 8 (strcat "Dup_" e))(assoc 8 ent_e) ent_e))
                      )
        )
            ))                              
  (prin1))

It will create a layer for every Type of Entity Found i.e. If duplicate lines are found it will create
Dup_LINES layer and so on..

Hope this helps

[teknomatika]

Thank you for your attention.
I could not tell what the situation is that the routine fails.
Apparently has to do with the different layers that belong to entities.
pBe, I tried but could not merge the code. It did not work. I appreciate that you do.

[pBe]

(defun c:finddup (/ ss dl en ed)
 
  (defun remove (expr lst)                                        ;;;REMOVE AN EXPRESSION FROM A LIST
    (apply 'append (subst nil (list expr) (mapcar 'list lst))))   ;;;TonyT or VNesterowski
  (foreach e '("3DFACE" "ARC" "ATTDEF" "CIRCLE" "LINE" "POINT"    ;;;FOREACH SIMPLE ENTITY TYPE
               "SHAPE" "SOLID" "TRACE" "TEXT" "MTEXT" "LWPOLYLINE" "ELLIPSE")
       (princ (strcat "\nSearching " e "s\n"))                    ;;;DISPLAY ENTITY TYPE
       (setq dl nil)                                              ;;;MAKE AN EMPTY COMPARISON LIST
       (and (setq ss (ssget "X" (list (cons 0 e))))               ;;;SEARCH FOR THIS ENTITY TYPE
            (set (read (strcat "S" e)) (ssadd))                   ;;;MAKE A UNIQUE PICKSET FOR EACH ENTITY TYPE
            (while (setq en (ssname ss 0))                        ;;;GET THE INITIAL PICKSET ENAME
                   (princ "\r") (prin1 en)                        ;;;PROGRESS DISPLAY
                   (setq ed (entget en))                          ;;;GET THE ENTITY DEFINITION
                   (foreach g '(-1 5)                             ;;;REMOVE THE ENAME
                       (setq ed (remove (assoc g ed) ed)))        ;;;AND HANDLE DATA
                   (if (member ed dl)                             ;;;IF THE ENTITY DEFINITION IS A MEMBER OF THE COMPASSION LIST
                       (ssadd en (eval (read (strcat "S" e))))    ;;;THEN ADD THE ENTITY TO THE DUPLICATE SET
                       (setq dl (cons ed dl)))                    ;;;ELSE ADD THE DEFINITION TO THE COMPARISON LIST
                   (ssdel en ss))
            (if (setq i (sslength (setq objs (eval (read (strcat "S" e))))))
  (repeat i
                (setq ent_e (entget (ssname objs (setq i (1- i)))))
                        (entmod (subst (cons 8 (strcat "Dup_" e))(assoc 8 ent_e) ent_e))
                             )
               )
           ))                               ;;;REMOVE THE CURRENT INITIAL PICKSET ENAME
  (prin1))

I added the code to Davids's 2nd post. I'm pretty sure his modification would be a lot elegant that that. so for now you can used that as is, until David updates his post (no disrespect D )

[David Bethel]

pBe, Thanks - you're fine. It's refreshing to see someone give proper credit on coding.

(defun c:makedupl (/ ss dl en ed ef)

  (defun remove (expr lst)                                        ;;;REMOVE AN EXPRESSION FROM A LIST
    (apply 'append (subst nil (list expr) (mapcar 'list lst))))   ;;;TonyT or VNesterowski

  (foreach e '("3DFACE" "ARC" "ATTDEF" "CIRCLE" "LINE" "POINT"    ;;;FOREACH SIMPLE ENTITY TYPE
               "SHAPE" "SOLID" "TRACE" "TEXT" "MTEXT" "LWPOLYLINE" "ELLIPSE")
       (princ (strcat "\nSearching " e "s\n"))                    ;;;DISPLAY ENTITY TYPE
       (setq dl nil)                                              ;;;MAKE AN EMPTY COMPARISON LIST
       (and (setq ss (ssget "X" (list (cons 0 e))))               ;;;SEARCH FOR THIS ENTITY TYPE
            (set (read (strcat "S" e)) (ssadd))                   ;;;MAKE A UNIQUE PICKSET FOR EACH ENTITY TYPE
            (while (setq en (ssname ss 0))                        ;;;GET THE INITIAL PICKSET ENAME
                   (princ "\r") (prin1 en)                        ;;;PROGRESS DISPLAY
                   (setq ed (entget en) ef ed)                    ;;;GET THE ENTITY DEFINITION
                   (foreach g '(-1 5)                             ;;;REMOVE THE ENAME
                       (setq ef (remove (assoc g ef) ef)))        ;;;AND HANDLE DATA
                   (if (member ef dl)                             ;;;IF THE ENTITY DEFINITION IS A MEMBER OF THE COMPASSION LIST
                       (progn                                     ;;;THEN
                         (ssadd en (eval (read (strcat "S" e))))  ;;;ADD THE ENTITY TO THE DUPLICATE SET
                         (entmod (subst (cons 8 (strcat "DUP_" e));;;AND
                                        (assoc 8 ed) ed)))        ;;;CHANGE IT'S LAYER
                       (setq dl (cons ef dl)))                    ;;;ELSE ADD THE DEFINITION TO THE COMPARISON SET
                   (ssdel en ss))))                               ;;;REMOVE THE CURRENT INITIAL PICKSET ENAME
  (prin1))                                                        ;;;EXIT CLEAN

I still like the PICKSET approach, but I made the change with each individual entity.

Again this will be a very slow run time routine on large drawings.. -David

[pBe]

pBe, Thanks - you're fine. It's refreshing to see someone give proper credit on coding.

You're welcome David cheers

[teknomatika]

pBe and David:
OK. Works.
However, if the entities belong to different layers, no longer works.
The differentiation into layers by different entities, it is interesting. However, in my case is irrelevant. Could be aggregated in the same layer.
In this context, I appreciate if you can get the routine work even considering that the entities may be duplicated in different layers and these with different colors.
Best explaining my definition of duplicate entities applies to entities with similar characteristics but may belong to different layers and, therefore, with different colors.
I hope my bad English does not become confused the issue.

[pBe]

You mean an exclusion list? There are times that duplicate layers or Lintypes or colors are valid? and there are times that they're not?
Or it would always be that way? geometry duplicates regardless of Layers/LT/Colors?

Problem I can see with that is, which one the two will be moved to "Duplicaetes" layer?

Anyhoo.. Try this

(defun c:test  (/ lvn objs entN ent OrgEnt ObjColl a Entcoll LstR dupobj ln nl ln)
      (vl-load-com)
      (setq objs (ssget ":L" '((0 . "~VIEWPORT") (0 . "~INSERT")(8 . "~*_D"))))
      (repeat (sslength objs)
            (setq entN (ssname objs 0))
            (setq OrgEnt (cons entN OrgEnt))
            (setq ent (entget entN))
            (foreach
                   itm
                      '(-1 5 8 62 6)
                  (setq ent (vl-remove (assoc (eval itm) ent) ent)))
            (setq ObjColl (cons ent ObjColl)
                  EntColl (cons (list ent entN) Entcoll))
            (ssdel entN objs))
      (while (setq a (car ObjColl))
   (if ( member a (cdr ObjColl))
                     (progn
             (setq ObjColl (vl-remove a (cdr ObjColl)))
                       (setq dupobj (entget (car (member
                                                   (setq LstR (cadr (assoc a  entcoll)))
                                                   OrgEnt))))
                       (entmod (subst (cons 8 (setq NL (strcat (cdr
                                                                     (setq ln (assoc 8 dupobj))) "_D")))
                                   (assoc 8 dupobj)  dupobj))
                       (if (not (member NL lvn))
                           (progn
                             (vla-put-color (vlax-ename->vla-object (tblobjname "LAYER" NL))
                                  (cdr (assoc 62 (tblsearch "LAYER" (cdr ln)))))
                                     (setq lvn (cons NL lvn))))
                       )
                 (setq ObjColl (cdr ObjColl)))
                   (prompt "\r\\")
            (princ LstR)
            (prompt "\t......Evaluating....please wait.. ")
            (princ)
            )
      (princ)
      )

Warning: Adverse effect on Anotative TEXT/MTEXT

[teknomatika]

pBe,
With the update is happening the following: The routine detects and locates in its own layer duplicate entities, but entities existing in the global design and that are not duplicated. Another definition for duplicate entities that I consider is the fact that they are overlapping each other. These are but overlapping entities duplicate what I intend to be differentiated.
On the other hand, the routine operates on the entire design. I intend to do so only in relation to elements within a selection.
Attached with a picture for better understanding.
Basically, I have two drawings with each other which have different geometric entities and equals geometric entities.
When I overlap the two drawings, I want the routine to select and isolate layer itself, these common entities (duplicate).

pBe,
By the way, the Text and Mtext entities, have no relevance to what I want.

I appreciate the attention being paid to the issue.

duplicates_example.jpg

[pBe]

pBe,
With the update is happening the following: The routine detects and locates in its own layer duplicate entities, but entities existing in the global design and that are not duplicated. Another definition for duplicate entities that I consider is the fact that they are overlapping each other. These are but overlapping entities duplicate what I intend to be differentiated.

Hence the statement
"Problem I can see with that is, which one the two will be moved to "Duplicates" layer?"

On the other hand, the routine operates on the entire design. I intend to do so only in relation to elements within a selection.

Change:
(setq objs (ssget "_X" '((0 . "~VIEWPORT") (0 . "~INSERT"))))
to:
(setq objs (ssget ":L" '((0 . "~VIEWPORT") (0 . "~INSERT"))))

By the way, the Text and Mtext entities, have no relevance to what I want.

Its a warning for other users to be aware of the effect.

Basically, I have two drawings with each other which have different geometric entities and equals geometric entities.
When I overlap the two drawings, I want the routine to select and isolate layer itself, these common entities (duplicate).

How'd you propose to go about doing that?
We could include a prompt to select an entity for layer information and retain enitities on that layer. and the rest would be moved to a new layer with the its original name with a suffix of _D?

Would that work for you?