[编程交流] 删除具有相同属性的块

(defun c:Test (/ sel all _atts lst del)
 ;;----------------------------------------------------;;
 ;;        ----==={ Tharwat - Date: 21.May.2016 }===----        ;;
 ;;         Select / Highlight all matched text strings        ;;
 ;;         as per the contents of the first one picked        ;;
 ;;----------------------------------------------------;;
 (princ "\nPick on Attribute Block to highlight all matched blocks with similar attributes:")
 (if (and (setq sel (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
          (setq all (ssget  "_X" (list '(0 . "INSERT") '(66 . 1) (cons 410 (getvar 'CTAB)))))
     )
   (progn
     (defun _atts (ent / str mtch)
       (mapcar '(lambda (v)
                  (if (/= (setq str (vla-get-textstring v)) "")
                    (setq mtch (cons str mtch))
                  )
                )
               (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes)
       )
       mtch
     )
     (setq lst (_atts (ssname sel 0))
           del (ssadd)
     )
     ((lambda (r / obj tmp atts)
        (while (setq obj (ssname all (setq r (1+ r))))
          (and (setq tmp lst)
               (setq atts (_atts obj))
               (vl-every '(lambda (a)
                            (if (member a tmp)
                              (progn
                                (setq tmp (vl-remove a tmp)) t
                              )
                            )
                          )
                         atts
               )
               (ssadd obj del)
          )
        )
      )
       -1
     )
     (sssetfirst nil del)
   )
 )
 (princ)
) (vl-load-com)

(defun c:Test (/ all _atts str fnd lst)
 ;;----------------------------------------------------;;
 ;;        ---==={ Tharwat - Date: 21.May.2016 }===---        ;;
 ;;         Select and delete all matched text strings        ;;
 ;;   as per the contents of the tag name POZITIA        ;;
 ;;----------------------------------------------------;;
 (if (setq all (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 410 (getvar 'CTAB)))))
   (progn
     (defun _atts (ent / str)
       (vl-some
         '(lambda (v)
            (if (= (strcase (vla-get-tagstring v)) "POZITIA")
              (setq str (vla-get-textstring v))
            )
          )
         (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes)
       )
       str
     )
     ((lambda (r / obj tmp atts)
        (while (setq obj (ssname all (setq r (1+ r))))
          (if (setq str (_atts obj))
            (if (setq fnd (assoc str lst))
              (setq lst (subst (list str (append (list obj) (cadr fnd)))
                           fnd
                           lst
                    )
              )
              (setq lst (cons (list str (list obj)) lst))
            )
          )
        )
      )
       -1
     )
     (if lst (mapcar '(lambda (e) (mapcar 'entdel (cdr (cadr e)))) lst))
   )
 )
 (princ)
)(vl-load-com)