Jump to content

Help - Select duplicate entities

teknomatika

By teknomatika
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

David Bethel Grand Master

David Bethel

Posted
Posted (edited)

User selection of lines to compare:

 

[color=#8b4513];;;  FIND LINES THAT HAVE COMMON ENDPOINTS REGARDLESS OF LAYER OR DIRECTION[/color]
[color=#8b4513];;;  CHANGE TO LAYER 'COMMON' AND DELETE DUPLICATES[/color]

[b][color=BLACK]([/color][/b]defun c:findclin [b][color=FUCHSIA]([/color][/b]/ ss ss2 en ed p10 p11 dl cl[b][color=FUCHSIA])[/color][/b]

[color=#8b4513];;;ROUND A POINT VALUE[/color]
[color=#8b4513];;;ARG -> Pointlist Decimalplace[/color]
[color=#8b4513];;;RET -> POINT LIST[/color]
 [b][color=FUCHSIA]([/color][/b]defun roundpt [b][color=NAVY]([/color][/b]p d[b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]atof [b][color=GREEN]([/color][/b]rtos [b][color=BLUE]([/color][/b]car p[b][color=BLUE])[/color][/b] 2 d[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
         [b][color=MAROON]([/color][/b]atof [b][color=GREEN]([/color][/b]rtos [b][color=BLUE]([/color][/b]cadr p[b][color=BLUE])[/color][/b] 2 d[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
         [b][color=MAROON]([/color][/b]atof [b][color=GREEN]([/color][/b]rtos [b][color=BLUE]([/color][/b]caddr p[b][color=BLUE])[/color][/b] 2 d[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
    
 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"LINE"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nPass #1...\n"[/color][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]setq ss2 [b][color=MAROON]([/color][/b]ssadd[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\r"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]prin1 en[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                  p10 [b][color=GREEN]([/color][/b]roundpt [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 10 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 8[b][color=GREEN])[/color][/b]
                  p11 [b][color=GREEN]([/color][/b]roundpt [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 11 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 8[b][color=GREEN])[/color][/b]
                  dl [b][color=GREEN]([/color][/b]cons [b][color=BLUE]([/color][/b]list p10 p11[b][color=BLUE])[/color][/b] dl[b][color=GREEN])[/color][/b]
                  dl [b][color=GREEN]([/color][/b]cons [b][color=BLUE]([/color][/b]list p11 p10[b][color=BLUE])[/color][/b] dl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssadd en ss2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]

      [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nPass #2...\n"[/color][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss2 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\r"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]prin1 en[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                  p10 [b][color=GREEN]([/color][/b]roundpt [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 10 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 8[b][color=GREEN])[/color][/b]
                  p11 [b][color=GREEN]([/color][/b]roundpt [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 11 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 8[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]or [b][color=BLUE]([/color][/b]member [b][color=RED]([/color][/b]list p10 p11[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]member [b][color=TEAL]([/color][/b]list p10 p11[b][color=TEAL])[/color][/b] dl[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                     [b][color=BLUE]([/color][/b]member [b][color=RED]([/color][/b]list p11 p10[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]member [b][color=TEAL]([/color][/b]list p11 p10[b][color=TEAL])[/color][/b] dl[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]entmod [b][color=BLUE]([/color][/b]subst '[b][color=RED]([/color][/b]8 . [color=#2f4f4f]"COMMON"[/color][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]assoc 8 ed[b][color=RED])[/color][/b] ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss2[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]

      [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"LINE"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]cons 8 [color=#2f4f4f]"COMMON"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nPass #3...\n"[/color][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\r"[/color][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]prin1 en[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                  p10 [b][color=GREEN]([/color][/b]roundpt [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 10 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 8[b][color=GREEN])[/color][/b]
                  p11 [b][color=GREEN]([/color][/b]roundpt [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 11 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 8[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]or [b][color=RED]([/color][/b]member [b][color=PURPLE]([/color][/b]list p10 p11[b][color=PURPLE])[/color][/b] cl[b][color=RED])[/color][/b]
                          [b][color=RED]([/color][/b]member [b][color=PURPLE]([/color][/b]list p11 p10[b][color=PURPLE])[/color][/b] cl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]setq cl [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]list p10 p11[b][color=RED])[/color][/b] cl[b][color=BLUE])[/color][/b]
                       cl [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]list p11 p10[b][color=RED])[/color][/b] cl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]entdel en[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]8 . [color=#2f4f4f]"COMMON"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] ss [color=#2f4f4f]""[/color] [color=#2f4f4f]"_C"[/color] [color=#2f4f4f]"BYLAYER"[/color] [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]alert [color=#2f4f4f]"No Common Lines Found"[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]redraw[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

 

pBe, I don't quite understand the 'first 10 & 11' direction request. -David

Edited by David Bethel
Cleanup
Link to comment
Share on other sites
  • Replies 72
  • Created
  • Last Reply

Top Posters In This Topic

  • teknomatika

    28

  • pBe

    18

  • ReMark

    10

  • David Bethel

    8

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

pBe Grand Master

pBe

Posted
Posted

it means:

 

Line created on layer 1

(10 176.099 133.178 0.0) (11 176.099 155.279 0.0)

Line created on layer 2

(10 176.099 155.279 0.0)(11 176.099 133.178 0.0)

 

Besides your new post already taken of that :D

 

Serves me right not testing the code before i make a suggestion

 

Nice David

Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

For now I'm like the result. Is working.

I want to thank everyone who helped me in this problem, especially to David and pBe.

Tanks.

Link to comment
Share on other sites
  • 3 weeks later...
  • 1 year later...
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

Dear PBE, David Bethel and Remark or other,

 

I thank you once again for your help in this routine, it has been very helpful to me. However, it could be an update so that in addition to everything he does, can preserve the type of line? For example, if the duplicated line is the Dashed type must be preserved as such

 

 

;;;  FIND LINES THAT HAVE COMMON ENDPOINTS REGARDLESS OF LAYER OR DIRECTION
;;;  CHANGE TO LAYER 'COMMON' AND DELETE DUPLICATES

(defun c:FINDDUP (/ ss ss2 en ed p10 p11 dl cl)

;;;ROUND A POINT VALUE
;;;ARG -> Pointlist Decimalplace
;;;RET -> POINT LIST
 (defun roundpt (p d)
   (list (atof (rtos (car p) 2 d))
         (atof (rtos (cadr p) 2 d))
         (atof (rtos (caddr p) 2 d))))
    
 (and (setq ss (ssget (list (cons 0 "LINE"))))
      (princ "\nPass #1...\n")
      (setq ss2 (ssadd))
      (while (setq en (ssname ss 0))
             (princ "\r") (prin1 en)
             (setq ed (entget en)
                  p10 (roundpt (cdr (assoc 10 ed)) 
                  p11 (roundpt (cdr (assoc 11 ed)) 
                  dl (cons (list p10 p11) dl)
                  dl (cons (list p11 p10) dl))
             (ssdel en ss)
             (ssadd en ss2))

      (princ "\nPass #2...\n")
      (while (setq en (ssname ss2 0))
             (princ "\r") (prin1 en)
             (setq ed (entget en)
                  p10 (roundpt (cdr (assoc 10 ed)) 
                  p11 (roundpt (cdr (assoc 11 ed)) )
             (if (or (member (list p10 p11) (cdr (member (list p10 p11) dl)))
                     (member (list p11 p10) (cdr (member (list p11 p10) dl))))
                 (entmod (subst '(8 . "COMMON") (assoc 8 ed) ed)))
             (ssdel en ss2))

      (setq ss (ssget "X" (list (cons 0 "LINE")(cons 8 "COMMON"))))
      (princ "\nPass #3...\n")
      (while (setq en (ssname ss 0))
             (princ "\r") (prin1 en)
             (setq ed (entget en)
                  p10 (roundpt (cdr (assoc 10 ed)) 
                  p11 (roundpt (cdr (assoc 11 ed)) )
             (if (not (or (member (list p10 p11) cl)
                          (member (list p11 p10) cl)))
                 (setq cl (cons (list p10 p11) cl)
                       cl (cons (list p11 p10) cl))
                 (entdel en))
             (ssdel en ss)))

 (if (setq ss (ssget "X" '((8 . "COMMON"))))
     (command "_.CHPROP" ss "" "_C" "BYLAYER" "")
     (alert "No Common Lines Found"))

 (redraw)
 (prin1))
(prompt "\nType: FINDDUP")

Link to comment
Share on other sites
  • 2 years later...
Rain0923 Enthusiast

Rain0923

Posted
Posted

I am looking for a utility that will move all duplicate entities to another layer, so I read these.

These lisp can't use in 2013, have anyone help me?

 

Searching ARCs

Searching CIRCLEs

Searching LINEs

Searching POINTs

Searching SOLIDs

Searching TRACEs

Link to comment
Share on other sites
  • 1 year later...
huts Newbie

huts

Posted
Posted

Hello, finddup is very useful, I have used it a lot flawlessly in AutoCAD 2012 years ago. Now I need it again, this time in newer versions of AutoCAD but it won’t work as good as before, many lines are “overseen” by the command. Is it possible to make a quick update to the routine so it would work as before in AutoCAD 2016? Thanks everyone, great work.

Link to comment
Share on other sites
  • 3 years later...
DanielP Newbie

DanielP

Posted
Posted

Hello guys, Just a simple question. I am trying to find a lisp that is able to select both duplicate objects (in my case lines).

In my case I need to delete both duplicate elements, and being left with just the objects that are not duplicated.

Please help.

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted
13 hours ago, DanielP said:

Hello guys, Just a simple question. I am trying to find a lisp that is able to select both duplicate objects (in my case lines).

In my case I need to delete both duplicate elements, and being left with just the objects that are not duplicated.

Please help.

If I understood you correctly, try this not so efficient snippet... It should remove all duplicates leaving only those that in start were unique (singles)...

  

(defun c:delduplins ( / ss i li lil dellst )
  (if (setq ss (ssget "_:L" '((0 . "LINE"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq li (ssname ss (setq i (1- i))))
        (setq lil (cons (list (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li))) li) lil))
      )
      (foreach li lil
        (if (vl-some '(lambda ( x ) (or (and (equal (car li) (car x) 1e-6) (equal (cadr li) (cadr x) 1e-6)) (and (equal (car li) (cadr x) 1e-6) (equal (cadr li) (car x) 1e-6)))) (vl-remove li lil))
          (setq dellst (cons (caddr li) dellst))
        )
      )
      (mapcar 'entdel dellst)
    )
  )
  (princ)
)

 

Link to comment
Share on other sites
  • 2 weeks later...
sadishpaul Newbie

sadishpaul

Posted
Posted

                                                                                                                                                                                                                                                                                                                          Dear marko_ribar 

your code works perfectly for lines

Can i get a similar code that works for circles ?

 

regards,

paul

 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

A quick and dirty if you copy the code and change the following should work not tested, but you will have to select again.

 

10 for circle is centre pt so ok

40 is radius so replace in (assoc 11 now (assoc 40

(0 . "line") now "(0 . "Circle")

 

The better is to do (0 , "Line,Circle") and have a IF (assoc 0 is a "Line" or "Circle" carry out the correct code steps. A good one to have a go at your self. We are here to help. 

(setq li (ssname ss (setq i (1- i))))
If goes here
        (setq lil (cons (list (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li))) li) lil))

If you want to check arcs a bit more involved as you have more variables to check.  Cen, Rad, Int ang, Start pt.

Edited by BIGAL
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...