Topic: Select similar blocks which have different names

[NICK_VNV]

I have hundreds of drawings with thousands of anonymous blocks. There are many blocks which have same geometry but have different names, so i can't ssget' them as needed. All of them are in one layer. I'm trying to select similar ones and put them to their own layer.

Could someone help me or have any ideas on how to do this?
Example drawing is attached

[ronjonp]

What version of cad do you have? Not sure when it was introduced but there is a SELECTSIMILAR command now.

[NICK_VNV]

I have SELECTSIMILAR command but it won't work because some blocks have different names. Did you tried open attached drawing?
Imagine it's like you draw 5 circles with same radius (other parameters may be the same also), but then you make 5 different blocks with unique names from each of them. SELECTSIMILAR would not recognize such blocks as similar.
For now I decided to write a lisp which will sort all anonymous blocks by comparing all their subentities. I think this may be a solution 

[ronjonp]

So you got it handled ? .. Another idea might be to compare the area of the bounding box of each block. If you set the tolerance tight enough it should be fairly accurate I'd think.

[NICK_VNV]

Another idea might be to compare the area of the bounding box of each block. If you set the tolerance tight enough it should be fairly accurate I'd think.

Oh.. this should be much faster I think. Probability of existence of different blocks with the same bounding box should be very low. I'll check both methods next week.
Thanks for help!

[lamarn]

It would really be a big help of there was a way to do a 'select similar' based on geometry or volume.
Revit has the ability to export family to block containing unique id names. Annoying and making dwg export huge.

Could it be done to replace then with one and the same. The only thing I am not able to do is to the good selecting in a quick way. Workaround would help. Thanks.

https://twitter.com/halammerts/status/577828905786163200

[NICK_VNV]

First try of selecting "similar" blocks by bounding box (with tolerance).

Code: [Select]

(defun blocks_select_same_bbox (fuzz / ent ss ss_lst size_x1 size_y1 size_x2 size_y2 ll1 ll2 ur1 ur2 new_ss)

 (setq ent (ssname (ssget "_:S" (list '(0 . "INSERT") )) 0))
 (vla-getboundingbox (vlax-ename->vla-object ent) 'll1 'ur1)
 (setq size_x1 (- (car (vlax-safearray->list ur1)) (car (vlax-safearray->list ll1))) )
 (setq size_y1 (- (cadr (vlax-safearray->list ur1)) (cadr (vlax-safearray->list ll1))) )

 (setq ss (ssget "_X" (list '(0 . "INSERT") )) )
 (setq ss_lst  (mapcar 'cadr (ssnamex ss)))
 
 (setq new_ss (ssadd))
 (foreach blk ss_lst
  (vla-getboundingbox (vlax-ename->vla-object blk) 'll2 'ur2)
  (setq size_x2 (- (car (vlax-safearray->list ur2)) (car (vlax-safearray->list ll2))) )
  (setq size_y2 (- (cadr (vlax-safearray->list ur2)) (cadr (vlax-safearray->list ll2))) )
  (if (and (< (abs(- size_x1 size_x2)) fuzz) (< (abs(- size_y1 size_y2)) fuzz))
   (setq new_ss (ssadd blk new_ss))
  )
 );foreach
 
 (sssetfirst nil new_ss)
 (vl-cmdf "_regen")
 new_ss
)

Run:
(blocks_select_same_bbox 0.01)

But this method works only if rotation of entities was the same before they become a block, otherwise boundig box diffrers significant 
So I'll check next method to compare subentities of blocks.

[Lee Mac]

Here's a rough draft to get you started:

Code - Auto/Visual Lisp: [Select]

1. ;; Select Similar Blocks  -  Lee Mac
2.  
3. (defun c:ssb ( / blk def ent lst tmp )
4.     (while
5.         (progn (setvar 'errno 0) (setq blk (car (entsel "\nSelect block: ")))
6.             (cond
7.                 (   (= 7 (getvar 'errno))
8.                     (princ "\nMissed, try again.")
9.                 )
10.                 (   (null blk) nil)
11.                 (   (/= "INSERT" (cdr (assoc 0 (setq blk (entget blk)))))
12.                     (princ "\nSelected object is not a block.")
13.                 )
14.             )
15.         )
16.     )
17.     (if blk
18.         (progn
19.             (while (setq def (tblnext "block" (null def)))
20.                 (setq ent (tblobjname "block" (cdr (assoc 2 def))))
21.                 (while (setq ent (entnext ent))
22.                     (setq tmp
23.                         (cons
24.                             (vl-sort
25.                                 (apply 'append
26.                                     (mapcar
27.                                         (function
28.                                             (lambda ( x )
29.                                                 (if (and (/= 'ename (type (cdr x))) (not (member (car x) '(5))))
30.                                                     (list x)
31.                                                 )
32.                                             )
33.                                         )
34.                                         (entget ent)
35.                                     )
36.                                 )
37.                                '(lambda ( a b )
38.                                     (if (= (car a) (car b))
39.                                         (if (listp (cdr a))
40.                                             (vl-some '< (cdr a) (cdr b))
41.                                             (< (cdr a) (cdr b))
42.                                         )
43.                                         (< (car a) (car b))
44.                                     )
45.                                 )
46.                             )
47.                             tmp
48.                         )
49.                     )
50.                 )
51.                 (setq lst (cons (cons (assoc 2 def) (reverse tmp)) lst)
52.                       tmp nil
53.                 )
54.             )
55.             (setq blk (cdr (assoc (assoc 2 blk) lst)))            
56.             (sssetfirst nil
57.                 (ssget "_X"
58.                     (append '((0 . "INSERT") (-4 . "<OR"))
59.                         (mapcar '(lambda ( x ) (cons 2 (LM:escapewildcards (cdar x))))
60.                             (vl-remove-if-not
61.                                 (function
62.                                     (lambda ( x )
63.                                         (vl-every
64.                                             (function
65.                                                 (lambda ( y )
66.                                                     (vl-some
67.                                                         (function
68.                                                             (lambda ( z )
69.                                                                 (vl-every
70.                                                                     (function
71.                                                                         (lambda ( a b )
72.                                                                             (and (= (car a) (car b))
73.                                                                                  (or (and (member (type (cdr a)) '(real list)) (equal (cdr a) (cdr b) 1e-8))
74.                                                                                      (= (cdr a) (cdr b))
75.                                                                                  )
76.                                                                             )
77.                                                                         )
78.                                                                     )
79.                                                                     y z
80.                                                                 )
81.                                                             )
82.                                                         )
83.                                                         (cdr x)
84.                                                     )
85.                                                 )
86.                                             )
87.                                             blk
88.                                         )
89.                                     )
90.                                 )
91.                                 lst
92.                             )
93.                         )
94.                        '((-4 . "OR>"))
95.                     )
96.                 )
97.             )
98.         )
99.     )
100.     (princ)
101. )
102.  
103. ;; Escape Wildcards  -  Lee Mac
104. ;; Escapes wildcard special characters in a supplied string
105.  
106. (defun LM:escapewildcards ( str )
107.     (vl-list->string
108.         (apply 'append
109.             (mapcar
110.                '(lambda ( c )
111.                     (if (member c '(35 64 46 42 63 126 91 93 45 44))
112.                         (list 96 c)
113.                         (list c)
114.                     )
115.                 )
116.                 (vl-string->list str)
117.             )
118.         )
119.     )
120. )
121.  
122. (princ)

EDIT: typo fixed.

[ronjonp]

That's pretty slick Lee

[lamarn]

I have tried both routines.
Thank you both for these fine codes, Lee Macs & Nick

Look like Nicks code works better and faster if I use it on a bunch of revit output.
This can work but now I found out that Revit produces very odd placed block definition.

The same 'looking' blocks fro Revit, as in AutoCAD you would model them, have different names but ALL WITH SAME ORIGIN .
To me this again shows how DWG from Revit is .. (hard to handle..)

 

[Lee Mac]

That's pretty slick Lee

Cheers Ron 

[Kerry]

That's pretty slick Lee

Yes it is.
... though I doubt a beginner will be able to follow the functionality 

[NICK_VNV]

Here's a rough draft to get you started:

Awesome Lee, it's a big help to "get started"  Thanks!

[HasanCAD]

LEE
Try to sellect thisblock (fist ar right) the lisp'll select 2 types

[Lee Mac]

Here's a rough draft to get you started:

Awesome Lee, it's a big help to "get started"  Thanks!

You're welcome! 

LEE
Try to sellect thisblock (fist ar right) the lisp'll select 2 types

Thanks Hasan - here is a much better version:

Code - Auto/Visual Lisp: [Select]

1. ;; Select Similar Blocks  -  Lee Mac
2.  
3. (defun c:ssb ( / blk def ent lst tmp )
4.     (while
5.         (progn (setvar 'errno 0) (setq blk (car (entsel "\nSelect block: ")))
6.             (cond
7.                 (   (= 7 (getvar 'errno))
8.                     (princ "\nMissed, try again.")
9.                 )
10.                 (   (null blk) nil)
11.                 (   (/= "INSERT" (cdr (assoc 0 (setq blk (entget blk)))))
12.                     (princ "\nSelected object is not a block.")
13.                 )
14.             )
15.         )
16.     )
17.     (if blk
18.         (progn
19.             (while (setq def (tblnext "block" (null def)))
20.                 (setq ent (tblobjname "block" (cdr (assoc 2 def)))
21.                       tmp nil
22.                 )
23.                 (while (setq ent (entnext ent))
24.                     (setq tmp
25.                         (append tmp
26.                             (vl-remove-if
27.                                '(lambda ( x ) (or (= 'ename (type (cdr x))) (member (car x) '(5))))
28.                                 (entget ent)
29.                             )
30.                         )
31.                     )
32.                 )
33.                 (setq lst
34.                     (cons
35.                         (cons (assoc 2 def)
36.                             (vl-sort tmp
37.                                '(lambda ( a b )
38.                                     (if (= (car a) (car b))
39.                                         (if (listp (cdr a)) (vl-some '< (cdr a) (cdr b)) (< (cdr a) (cdr b)))
40.                                         (< (car a) (car b))
41.                                     )
42.                                 )
43.                             )
44.                         )
45.                         lst
46.                     )
47.                 )
48.             )
49.             (setq blk (cdr (assoc (assoc 2 blk) lst)))            
50.             (sssetfirst nil
51.                 (ssget "_X"
52.                     (append '((0 . "INSERT") (-4 . "<OR"))
53.                         (mapcar '(lambda ( x ) (cons 2 (LM:escapewildcards (cdar x))))
54.                             (vl-remove-if-not
55.                                '(lambda ( x )
56.                                     (vl-every
57.                                        '(lambda ( a b )
58.                                             (and (= (car a) (car b))
59.                                                  (or (and (member (type (cdr a)) '(real list)) (equal (cdr a) (cdr b) 1e-8))
60.                                                      (= (cdr a) (cdr b))
61.                                                  )
62.                                             )
63.                                         )
64.                                         blk (cdr x)
65.                                     )
66.                                 )
67.                                 lst
68.                             )
69.                         )
70.                        '((-4 . "OR>"))
71.                     )
72.                 )
73.             )
74.         )
75.     )
76.     (princ)
77. )
78.  
79. ;; Escape Wildcards  -  Lee Mac
80. ;; Escapes wildcard special characters in a supplied string
81.  
82. (defun LM:escapewildcards ( str )
83.     (vl-list->string
84.         (apply 'append
85.             (mapcar
86.                '(lambda ( c )
87.                     (if (member c '(35 64 46 42 63 126 91 93 45 44))
88.                         (list 96 c)
89.                         (list c)
90.                     )
91.                 )
92.                 (vl-string->list str)
93.             )
94.         )
95.     )
96. )
97.  
98. (princ)