Jump to content

Remove block duplicates with different attributes

hrehor

By hrehor
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

hrehor Apprentice

hrehor

Posted
Posted

Hi all,

I came across a problem with finding duplicates of blocks that have different attributes. Overkill doesn't find them, nor any of LISPs I found on the web - duprem, dupdel, deldup.

A simple LISP that would highlight/select blocks that have same insertion point would do the thing. Anyone has a LISP like that?

Greg

leigh_elkins Apprentice

leigh_elkins

Posted
Posted

Can you not just use quick select and then filter the properties?

hrehor Apprentice

hrehor

Posted
  • Author
Posted

I don't quite get it. I select 77 of my blocks and in properties I have *varies* in X and Y. How can I know which of 77 blocks have the same insertion points (all of them should be different)?

leigh_elkins Apprentice

leigh_elkins

Posted
Posted

So the blocks all have the same name but with a different insertion point?

Sorry but I am not sure I completely understand your situation.

dbroada Grand Master

dbroada

Posted
Posted

I'm reading the problem as.....

 

He has 77 blocks of one type in his drawing. SOME of these blocks are placed on top of each other. He wants to be able to remove the duplicate blocks to end up with just one block for each insertion point.

 

but I could be reading the question incorreclty.

hrehor Apprentice

hrehor

Posted
  • Author
Posted
I'm reading the problem as.....

 

He has 77 blocks of one type in his drawing. SOME of these blocks are placed on top of each other. He wants to be able to remove the duplicate blocks to end up with just one block for each insertion point.

 

but I could be reading the question incorreclty.

Exactly. Once the problem is finally described, anybody has a solution?

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

This may be a touch overkill, but I wanted to write something interesting :)

  

(defun c:BlockDupes (/ GroupByFoo i ss e eLst)
 (vl-load-com)
 ;; Lee Mac  ~  16.04.10

 (defun GroupByFoo ( foo lst / f g )
   (defun f ( x l )
     (if l
       (cons (vl-remove-if-not
               (function
                 (lambda (a)
                   (foo x a))) l)
             (g (vl-remove-if
                  (function
                    (lambda (a)
                      (foo x a))) l)))))

   (defun g ( l )
     (if l
       (f (car l) l)))

   (g lst))

 (if (setq i -1 ss (ssget "_X" '((0 . "INSERT"))))
   (progn
     (while (setq e (ssname ss (setq i (1+ i))))
       (setq eLst (cons (cons e (cdr (assoc 10 (entget e)))) eLst)))

     (mapcar
       (function
         (lambda ( group )
           (if (> 2 (vl-list-length group))
             (mapcar
               (function
                 (lambda ( entity )
                   (ssdel entity ss)
                 )
               )
               (mapcar
                 (function car) group
               )
             )
           )
         )
       )
       (GroupByFoo
         (lambda (a b)
           (equal (cdr a) (cdr b) 1e-4)
         )
         eLst
       )
     )
     (sssetfirst nil ss)
   )
 )
 (princ)
)
 
Edited by Lee Mac
dbroada Grand Master

dbroada

Posted
Posted

having decided that you have a number of blocks on top of each other, how do you know which one had the correct attribute?

hrehor Apprentice

hrehor

Posted
  • Author
Posted
having decided that you have a number of blocks on top of each other, how do you know which one had the correct attribute?

That could have been a problem,but in my case blocks are room tags, where the only difference is area attribute. After cleaning I will get the right att. or empty - it is visually easy to distinguish. I need to delete duplicates to avoid problems in data extraction. DX could be other way to find duplicates by comparing blocks positions, but very ineffective.

Greg

hrehor Apprentice

hrehor

Posted
  • Author
Posted
This may be a touch overkill, but I wanted to write something interesting :)

 

thank you Lee Mac. YOU ROCK :-)

did you just write it?

 

Greg

Lee Mac Grand Master

Lee Mac

Posted
Posted
thank you Lee Mac. YOU ROCK :-)

 

Thanks Greg :)

 

did you just write it?

 

Yes :)

  • 7 years later...
Least Enthusiast

Least

Posted
Posted

Hi Lee

 

An old post but a useful routine.

 

I was wondering how to modify your blockdupes routine so that one of the duplicate blocks is left unselected in each instance, then I can run a command to delete previous or to move the duplicate blocks to a new layer.

It doesn't matter which duplicate block is left. I have attached an example drawing, how can I go about modifying the selection to achieve this? I would be thankful for any help with this as I don't know where to start.

 

It would be like an overkill for duplicate blocks.

 

Many thanks

block dupes.dwg

Lee Mac Grand Master

Lee Mac

Posted
Posted

Consider the following:

(defun c:blockdupes ( / ent idx ins lst rtn sel )
   (if (setq sel (ssget "_X" '((0 . "INSERT"))))
       (progn
           (setq rtn (ssadd))
           (repeat (setq idx (sslength sel))
               (setq ent (ssname sel (setq idx (1- idx)))
                     ins (cdr (assoc 10 (entget ent)))
               )
               (if (vl-some '(lambda ( x ) (equal ins x 1e-4)) lst)
                   (ssadd ent rtn)
                   (setq lst (cons ins lst))
               )
           )
           (sssetfirst nil rtn)
       )
   )
   (princ)
)

Note that the code considers blocks to be duplicate based solely on insertion point coordinates which are within 1e-4 (0.0001) units of each other, independent of block name.

  • Thanks 1
Least Enthusiast

Least

Posted
Posted

Thanks Lee it works perfectly

I have added (66 . 1) to select only attributed blocks to the selection set criteria and it does exactly what I was after.

 

Thank you very much!

  • 2 years later...
Pugazh Enthusiast

Pugazh

Posted
Posted (edited)
On 04/08/2017 at 02:06, Lee Mac said:

Consider the following: 


(defun c:blockdupes ( / ent idx ins lst rtn sel )
   (if (setq sel (ssget "_X" '((0 . "INSERT"))))
       (progn
           (setq rtn (ssadd))
           (repeat (setq idx (sslength sel))
               (setq ent (ssname sel (setq idx (1- idx)))
                     ins (cdr (assoc 10 (entget ent)))
               )
               (if (vl-some '(lambda ( x ) (equal ins x 1e-4)) lst)
                   (ssadd ent rtn)
                   (setq lst (cons ins lst))
               )
           )
           (sssetfirst nil rtn)
       )
   )
   (princ)
)
 

Note that the code considers blocks to be duplicate based solely on insertion point coordinates which are within 1e-4 (0.0001) units of each other, independent of block name.

 

 

Hi lee,

 

  how to select this two block

 

Original Block (entget (car (entsel))) 

((-1 . <Entity name: 7fffe0ed940>) (0 . "INSERT") (330 . <Entity name: 7fffefcb9b0>) (5 . "5B636C") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "RANGELAYB1") (6 . "Continuous") (48 . 10.0) (100 . "AcDbBlockReference") (2 . "*U2120") (10 1.01773e+006 148993.0 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))

 

Duplicate Block (entget (car (entsel))) 

((-1 . <Entity name: 7fffdd7e300>) (0 . "INSERT") (330 . <Entity name: 7fffefcb9b0>) (5 . "62E218") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "RANGELAYB1") (6 . "Continuous") (48 . 10.0) (100 . "AcDbBlockReference") (2 . "*U3336") (10 1.01858e+006 149389.0 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))

 

Edited by Pugazh
BIGAL Grand Master

BIGAL

Posted
Posted

The assoc 5 is the handle of the block this is a unique id if you want two try (5 . "62E218,5B636C")

  • Like 1
  • 4 years later...
JayR Newbie

JayR

Posted
Posted
On 4/16/2010 at 2:16 PM, Lee Mac said:

This may be a touch overkill, but I wanted to write something interesting :)

 

  

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:BlockDupes [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] GroupByFoo i ss e eLst[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
 [i][color=#990099];; Lee Mac  ~  16.04.10[/color][/i]

 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] GroupByFoo [b][color=RED]([/color][/b] foo lst [b][color=BLUE]/[/color][/b] f g [b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] f [b][color=RED]([/color][/b] x l [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] l
       [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-remove-if-not[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]a[b][color=RED])[/color][/b]
                   [b][color=RED]([/color][/b]foo x a[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] l[b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b]g [b][color=RED]([/color][/b][b][color=BLUE]vl-remove-if[/color][/b]
                  [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
                    [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]a[b][color=RED])[/color][/b]
                      [b][color=RED]([/color][/b]foo x a[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] l[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] g [b][color=RED]([/color][/b] l [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] l
       [b][color=RED]([/color][/b]f [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] l[b][color=RED])[/color][/b] l[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b]g lst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=#009900]-1[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#a52a2a]"_X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#a52a2a]"INSERT"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] i[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] eLst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] e[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] eLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

     [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] group [b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] [b][color=#009900]2[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-list-length[/color][/b] group[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b] entity [b][color=RED])[/color][/b]
                   [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] entity ss[b][color=RED])[/color][/b]
                 [b][color=RED])[/color][/b]
               [b][color=RED])[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]function[/color][/b] [b][color=Blue]car[/color][color=RED])[/color][/b] group
               [b][color=RED])[/color][/b]
             [b][color=RED])[/color][/b]
           [b][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
       [b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b]GroupByFoo
         [b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]a b[b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]equal[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] a[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] b[b][color=RED])[/color][/b] [b][color=Teal]1e-4[/color][color=RED])[/color][/b]
         [b][color=RED])[/color][/b]
         eLst
       [b][color=RED])[/color][/b]
     [b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]sssetfirst[/color][/b] [b][color=BLUE]nil[/color][/b] ss[b][color=RED])[/color][/b]
   [b][color=RED])[/color][/b]
 [b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b]
[b][color=RED])[/color][/b]
 

 

Could you please provide the plain text version of this code? I'm unable to view it otherwise. Thank you.

Lee Mac Grand Master

Lee Mac

Posted
Posted

I've updated my earlier post to remove the BBCode formatting - however, I should note that the code is very old!

JayR Newbie

JayR

Posted
Posted
On 2/2/2024 at 5:57 PM, Lee Mac said:

I've updated my earlier post to remove the BBCode formatting - however, I should note that the code is very old!

Hi Lee,

 

Thank you for updating. I appreciate it.

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...