[编程交流] 可以做额外的东西

(defun c:Test (/ b nm bks ss i sn e l lst g n)
 ;;------------------------------------;;
 ;;        Tharwat 20.05.2015                ;;
 ;;        Highligh Duplicated blocks        ;;
 ;;------------------------------------;;
 (while (setq b (tblnext "BLOCK" (not b)))
   (if (and (not (assoc 1 b))
            (not (wcmatch (setq nm (cdr (assoc 2 b))) "*|*"))
       )
     (setq bks (cons nm bks))
   )
 )
 (princ
   "\nSelect Blocks to highligh duplicates in position :"
 )
 (if (setq g  (ssadd)
           ss (ssget
                "_:L"
                (list
                  '(0 . "INSERT")
                  (cons
                    2
                    (apply 'strcat (mapcar '(lambda (u) (strcat u ",")) bks))
                  )
                )
              )
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i)))
             e  (entget sn)
             l  (cons (list sn (cdr (assoc 10 e))) l)
       )
     )
     (mapcar '(lambda (p)
                (if (vl-some '(lambda (q)
                                (and
                                  (equal (cadr p) (cadr q) 1e-4)
                                  (not (eq (car p) (car q)))
                                  (not (member (cadr q) lst))
                                )
                              )
                             l
                    )
                  (progn
                    (setq lst (cons (cadr p) lst))
                    (ssadd (car p) g)
                  )
                )
              )
             l
     )
     (if (< 0 (setq n (sslength g)))
       (princ (strcat "\nNumber of Duplicated Blocks found [ "
                      (itoa n)
                      " ] :"
              )
       )
       (princ "\nNo duplicate Blocks found !")
     )
   )
 )
 (sssetfirst nil g)
 (princ)
)