社区 › Auto Lisp › 特定块/属性lisp

Lee Mac 发表于 2022-7-5 19:17:23

请尝试以下操作：

(defun c:setattval ( / ent enx idx itm lst sel tag tmp val )
   (if (setq sel (ssget "_:L" '((0 . "INSERT") (66 . 1))))
       (progn
         (repeat (setq idx (sslength sel))
               (setq ent (entnext (ssname sel (setq idx (1- idx))))
                     enx (entget ent)
               )
               (while (= "ATTRIB" (cdr (assoc 0 enx)))
                   (setq tag (strcase (cdr (assoc 2 enx)))
                         itm (assoc tag lst)
                   )
                   (if itm
                     (setq lst (subst (vl-list* tag enx (cdr itm)) itm lst))
                     (setq lst (cons(list tag enx) lst))
                   )
                   (setq ent (entnext ent)
                         enx (entgetent)
                   )
               )
         )
         (while
               (progn (setq tag (strcase (getstring "\nSpecify tag: ")))
                   (cond
                     (   (= "" tag) nil)
                     (   (null(setq tmp (vl-remove-if-not '(lambda ( x ) (wcmatch (car x) (strcat tag "*"))) lst)))
                           (princ (strcat "\nNo tags starting with \"" tag "\" found in selection."))
                     )
                     (   (cdr tmp)
                           (princ
                               (strcat "\n" (itoa (length tmp)) " matches found: "
                                 (substr(apply 'strcat (mapcar '(lambda ( x ) (strcat "," (car x))) tmp)) 2)
                                 " - Please be more specific."
                               )
                           )
                     )
                   )
               )
         )
         (if (/= "" tag)
               (progn
                   (setq val (cons 1 (getstring t "\nSpecify new value: ")))
                   (foreach enx (cdar tmp)
                     (if (entmod (subst val (assoc 1 enx) enx))
                           (entupd (cdr (assoc -1 enx)))
                     )
                   )
                   (princ
                     (strcat "\n"
                           (itoa (length (cdar tmp)))
                           " attribute"
                           (if (cddar tmp) "s" "")
                           " modified."
                     )
                   )
               )
         )
       )
   )
   (princ)
)

我很高兴这个程序很有用。

ttray33y 发表于 2022-7-5 19:19:28

 
我真的很喜欢这个huy，我觉得lisp对他来说就像小学数学。

Lee Mac 发表于 2022-7-5 19:23:53

谢谢你，你真是太好了。

Losinski 发表于 2022-7-5 19:26:35

我做了一个快速的测试，它似乎一切工作所描述的。谢谢李！

Lee Mac 发表于 2022-7-5 19:30:45

我的荣幸。

查看完整版本: 特定块/属性lisp