社区 › Auto Lisp › 删除具有相同属性的块

sergiu_ciuhnenc 发表于 2022-7-5 17:40:04

删除具有相同属性的块

我再次需要你的帮助！！！
可以帮我找一个可以删除相同属性块的芸香碱；
谢谢你的建议，每次都能帮上忙

BIGAL 发表于 2022-7-5 17:53:01

需要更多信息，比如它只是一个块名，哪个属性需要标记名。发布dwg。

sergiu_ciuhnenc 发表于 2022-7-5 18:04:22

下面是块的示例
删除DUP。图纸

Tharwat 发表于 2022-7-5 18:07:43

你好
 
尝试此程序：
 

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

sergiu_ciuhnenc 发表于 2022-7-5 18:19:24

你好，塔瓦！！！
谢谢你总是遇到急救问题！！！
这是可行的，但单独选择每个属性需要花费很多时间，是否可以自动选择和删除具有相同属性“Pozitia”的块，但不能删除所有块，而只能删除其中一个

Tharwat 发表于 2022-7-5 18:23:10

 
你好
 
像这样的？
 

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

sergiu_ciuhnenc 发表于 2022-7-5 18:31:46

Yuhaaaaa！！！！！！！！！
非常感谢Tharwat！！！
现在它工作得很好！！！

Tharwat 发表于 2022-7-5 18:42:16

非常欢迎你。

查看完整版本: 删除具有相同属性的块