Print Page - Select similar blocks which have different names

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: NICK_VNV on June 26, 2015, 03:02:02 AM

Title: Select similar blocks which have different names
Post by: NICK_VNV on June 26, 2015, 03:02:02 AM

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

Title: Re: Select similar blocks which have different names
Post by: ronjonp on June 26, 2015, 09:00:31 AM

What version of cad do you have? Not sure when it was introduced but there is a SELECTSIMILAR (http://help.autodesk.com/view/ACD/2016/ENU/?guid=GUID-C160A9C9-1287-4111-8D27-05AFBAA7C29F) command now.

Title: Re: Select similar blocks which have different names
Post by: NICK_VNV on June 26, 2015, 01:06:09 PM

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 :-D

Title: Re: Select similar blocks which have different names
Post by: ronjonp on June 26, 2015, 02:36:45 PM

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.

Title: Re: Select similar blocks which have different names
Post by: NICK_VNV on June 27, 2015, 01:42:35 AM

Quote from: ronjonp on June 26, 2015, 02:36:45 PM

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! :-)

Title: Re: Select similar blocks which have different names
Post by: lamarn on June 27, 2015, 05:24:02 AM

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

Title: Re: Select similar blocks which have different names
Post by: NICK_VNV on June 29, 2015, 07:08:18 AM

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.

Title: Re: Select similar blocks which have different names
Post by: Lee Mac on June 29, 2015, 01:28:10 PM

Here's a rough draft to get you started:

Code - Auto/Visual Lisp: [Select]

;; Select Similar Blocks  -  Lee Mac
 
(defun c:ssb ( / blk def ent lst tmp )
    (while
        (progn (setvar 'errno 0) (setq blk (car (entsel "\nSelect block: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null blk) nil)
                (   (/= "INSERT" (cdr (assoc 0 (setq blk (entget blk)))))
                    (princ "\nSelected object is not a block.")
                )
            )
        )
    )
    (if blk
        (progn
            (while (setq def (tblnext "block" (null def)))
                (setq ent (tblobjname "block" (cdr (assoc 2 def))))
                (while (setq ent (entnext ent))
                    (setq tmp
                        (cons
                            (vl-sort
                                (apply 'append
                                    (mapcar
                                        (function
                                            (lambda ( x )
                                                (if (and (/= 'ename (type (cdr x))) (not (member (car x) '(5))))
                                                    (list x)
                                                )
                                            )
                                        )
                                        (entget ent)
                                    )
                                )
                               '(lambda ( a b )
                                    (if (= (car a) (car b))
                                        (if (listp (cdr a))
                                            (vl-some '< (cdr a) (cdr b))
                                            (< (cdr a) (cdr b))
                                        )
                                        (< (car a) (car b))
                                    )
                                )
                            )
                            tmp
                        )
                    )
                )
                (setq lst (cons (cons (assoc 2 def) (reverse tmp)) lst)
                      tmp nil
                )
            )
            (setq blk (cdr (assoc (assoc 2 blk) lst)))            
            (sssetfirst nil
                (ssget "_X"
                    (append '((0 . "INSERT") (-4 . "<OR"))
                        (mapcar '(lambda ( x ) (cons 2 (LM:escapewildcards (cdar x))))
                            (vl-remove-if-not
                                (function
                                    (lambda ( x )
                                        (vl-every
                                            (function
                                                (lambda ( y )
                                                    (vl-some
                                                        (function
                                                            (lambda ( z )
                                                                (vl-every
                                                                    (function
                                                                        (lambda ( a b )
                                                                            (and (= (car a) (car b))
                                                                                 (or (and (member (type (cdr a)) '(real list)) (equal (cdr a) (cdr b) 1e-8))
                                                                                     (= (cdr a) (cdr b))
                                                                                 )
                                                                            )
                                                                        )
                                                                    )
                                                                    y z
                                                                )
                                                            )
                                                        )
                                                        (cdr x)
                                                    )
                                                )
                                            )
                                            blk
                                        )
                                    )
                                )
                                lst
                            )
                        )
                       '((-4 . "OR>"))
                    )
                )
            )
        )
    )
    (princ)
)
 
;; Escape Wildcards  -  Lee Mac
;; Escapes wildcard special characters in a supplied string
 
(defun LM:escapewildcards ( str )
    (vl-list->string
        (apply 'append
            (mapcar
               '(lambda ( c )
                    (if (member c '(35 64 46 42 63 126 91 93 45 44))
                        (list 96 c)
                        (list c)
                    )
                )
                (vl-string->list str)
            )
        )
    )
)
 
(princ)

EDIT: typo fixed.

Title: Re: Select similar blocks which have different names
Post by: ronjonp on June 29, 2015, 02:41:04 PM

That's pretty slick Lee :)

Title: Re: Select similar blocks which have different names
Post by: lamarn on June 29, 2015, 05:34:15 PM

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

Title: Re: Select similar blocks which have different names
Post by: Lee Mac on June 29, 2015, 06:30:32 PM

Quote from: ronjonp on June 29, 2015, 02:41:04 PM

That's pretty slick Lee :)

Cheers Ron :-)

Title: Re: Select similar blocks which have different names
Post by: Kerry on June 29, 2015, 06:47:11 PM

Quote from: ronjonp on June 29, 2015, 02:41:04 PM

That's pretty slick Lee :)

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

Title: Re: Select similar blocks which have different names
Post by: NICK_VNV on June 30, 2015, 02:17:22 AM

Quote from: Lee Mac on June 29, 2015, 01:28:10 PM

Here's a rough draft to get you started:

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

Title: Re: Select similar blocks which have different names
Post by: HasanCAD on June 30, 2015, 04:29:59 AM

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

Title: Re: Select similar blocks which have different names
Post by: Lee Mac on June 30, 2015, 02:39:43 PM

Quote from: NICK_VNV on June 30, 2015, 02:17:22 AM

Quote from: Lee Mac on June 29, 2015, 01:28:10 PM
Here's a rough draft to get you started:
Awesome Lee, it's a big help to "get started" :-) Thanks!

You're welcome! :-)

Quote from: HasanCAD on June 30, 2015, 04:29:59 AM

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]

;; Select Similar Blocks  -  Lee Mac
 
(defun c:ssb ( / blk def ent lst tmp )
    (while
        (progn (setvar 'errno 0) (setq blk (car (entsel "\nSelect block: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null blk) nil)
                (   (/= "INSERT" (cdr (assoc 0 (setq blk (entget blk)))))
                    (princ "\nSelected object is not a block.")
                )
            )
        )
    )
    (if blk
        (progn
            (while (setq def (tblnext "block" (null def)))
                (setq ent (tblobjname "block" (cdr (assoc 2 def)))
                      tmp nil
                )
                (while (setq ent (entnext ent))
                    (setq tmp
                        (append tmp
                            (vl-remove-if
                               '(lambda ( x ) (or (= 'ename (type (cdr x))) (member (car x) '(5))))
                                (entget ent)
                            )
                        )
                    )
                )
                (setq lst
                    (cons
                        (cons (assoc 2 def)
                            (vl-sort tmp
                               '(lambda ( a b )
                                    (if (= (car a) (car b))
                                        (if (listp (cdr a)) (vl-some '< (cdr a) (cdr b)) (< (cdr a) (cdr b)))
                                        (< (car a) (car b))
                                    )
                                )
                            )
                        )
                        lst
                    )
                )
            )
            (setq blk (cdr (assoc (assoc 2 blk) lst)))            
            (sssetfirst nil
                (ssget "_X"
                    (append '((0 . "INSERT") (-4 . "<OR"))
                        (mapcar '(lambda ( x ) (cons 2 (LM:escapewildcards (cdar x))))
                            (vl-remove-if-not
                               '(lambda ( x )
                                    (vl-every
                                       '(lambda ( a b )
                                            (and (= (car a) (car b))
                                                 (or (and (member (type (cdr a)) '(real list)) (equal (cdr a) (cdr b) 1e-8))
                                                     (= (cdr a) (cdr b))
                                                 )
                                            )
                                        )
                                        blk (cdr x)
                                    )
                                )
                                lst
                            )
                        )
                       '((-4 . "OR>"))
                    )
                )
            )
        )
    )
    (princ)
)
 
;; Escape Wildcards  -  Lee Mac
;; Escapes wildcard special characters in a supplied string
 
(defun LM:escapewildcards ( str )
    (vl-list->string
        (apply 'append
            (mapcar
               '(lambda ( c )
                    (if (member c '(35 64 46 42 63 126 91 93 45 44))
                        (list 96 c)
                        (list c)
                    )
                )
                (vl-string->list str)
            )
        )
    )
)
 
(princ)

Title: Re: Select similar blocks which have different names
Post by: 3dwannab on March 30, 2022, 05:27:34 PM

Here's one that uses the built-in SELECTSIMILAR command switching the SELECTSIMILARMODE variable to 128 which is for name only.

Credit to Lee for some code in there.

Code: [Select]

;;
;; Select Similar Blocks by name
;; Updated by 3dwannab on 2022.03.30.
;;
;; I updated this on the 2022.03.30 to use the SELECTSIMILAR command by setting
;; the SELECTSIMILARMODE to 128 which is to select similar by name.
;; Along with a filter for the selection of blocks, after this it's pretty simple.
;;
;; Initial code was here by Lee Mac: http://www.theswamp.org/index.php?topic=49667.msg548516#msg548516
;;

(defun c:QSBlocks_Similar ( / *error* acDoc def lst ss1 ss2 var_cmdecho var_osmode var_selectsimilarmode )

  (princ "Filter select all similar Blocks by name :\n")

  (defun *error* (errmsg)
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg
     (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " errmsg " >>\n"))
     )
    (setvar 'cmdecho var_cmdecho)
    (setvar 'osmode var_osmode)
    (setvar 'selectsimilarmode var_selectsimilarmode)
    )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq var_cmdecho (getvar 'cmdecho))
  (setq var_osmode (getvar 'osmode))
  (setq var_selectsimilarmode (getvar 'selectsimilarmode))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)

  ; Code by Lee Mac http://www.cadtutor.net/forum/showthread.php?92638-Simple-fix-%28LISP-noob%29-Syntax-problem&p=633824&viewfull=1#post633824
  ;; Iterate over the block table and compile a list of xref blocks to exclude
  (while (setq def (tblnext "block" (not def)))
   (if (= 4 (logand 4 (cdr (assoc 70 def))))
     (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
     )
   )

  ;; Attempt to retrieve a selection of blocks (but not xrefs)
  (setq ss1 (ssget (cons '(0 . "INSERT") (if lst (vl-list* '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '((-4 . "NOT>")))))))

  ;; Set selectsimilarmode to use the name of an object.
  (setvar 'selectsimilarmode 128)

  ;; If ss1 one is valid then do this
  (if ss1
    (progn
      (vl-cmdf "_.selectsimilar" ss1 "")
      (setq ss2 (ssget)) ;; Create a new selection set for to zoom and reselect as the zoom objects will do this
      (command "_.zoom" "_O" ss2 "")
      (sssetfirst nil ss2)
      (princ (strcat "\n: ------------------------------\n\t\t<<< "(itoa (sslength ss2)) (if (> (sslength ss2) 1) " <<< INSERTS objects" " <<< INSERT object") " selected\n: ------------------------------\n"))
      )
    (princ "\n: ------------------------------\n\t\t*** Nothing Selected ***\n: ------------------------------\n")
    )

  (*error* nil) (princ)

  )

TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: NICK_VNV on June 26, 2015, 03:02:02 AM