社区 › Auto Lisp › Lee Mac lisp修改-Ke

Organic 发表于 2022-7-5 16:18:55

Lee Mac lisp修改-Ke

嗨，李和其他人，
 
关于李的密码https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-all-to-0-layer-by-layer-including-block-and-block-in/td-p/5376995
 
(defun c:blkto0 ( / idx lst sel )
(if (setq sel (ssget '((0 . "INSERT"))))
(repeat (setq idx (sslength sel))
(block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
)
)
(command "_.regen")
(princ)
)
(defun block->0 ( blk / ent enx )
(cond
( (member blk lst))
( (setq ent (tblobjname "block" blk))
(while (setq ent (entnext ent))
(entmod (subst-append 8 "0" (subst-append 62 0 (setq enx (entget ent)))))
(if (= "INSERT" (cdr (assoc 0 enx)))
(block->0 (cdr (assoc 2 enx)))
)
)
(setq lst (cons blk lst))
)
)
)
(defun subst-append ( key val lst / itm )
(if (setq itm (assoc key lst))
(subst (cons key val) itm lst)
(append lst (list (cons key val)))
)
)
 
当图纸设置良好时，上述效果非常好，但不幸的是，许多建筑图纸都不符合要求。。。
 
是否可以对此进行修改，使其将所有块/嵌套块的颜色设置为如上所述的“按块”颜色，尽管这样块/嵌套块都保留其原始层（即不转到第0层等）？
 
谢谢

Organic 发表于 2022-7-5 16:55:57

我解决了
 
删除图层更改部分（subst append 8“0”及其右括号完成！
 
(defun c:blkto0 ( / idx lst sel )
(if (setq sel (ssget '((0 . "INSERT"))))
(repeat (setq idx (sslength sel))
(block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
)
)
(command "_.regen")
(princ)
)
(defun block->0 ( blk / ent enx )
(cond
( (member blk lst))
( (setq ent (tblobjname "block" blk))
(while (setq ent (entnext ent))
(entmod (subst-append 62 0 (setq enx (entget ent))))
(if (= "INSERT" (cdr (assoc 0 enx)))
(block->0 (cdr (assoc 2 enx)))
)
)
(setq lst (cons blk lst))
)
)
)
(defun subst-append ( key val lst / itm )
 
谢谢你的Lisp程序。

Lee Mac 发表于 2022-7-5 17:46:57

你的修改是正确的-做得好。
 
以下是带有适当缩进的代码：
(defun c:blkto0 ( / idx lst sel )
   (if (setq sel (ssget '((0 . "INSERT"))))
       (repeat (setq idx (sslength sel))
         (block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
       )
   )
   (command "_.regen")
   (princ)
)
(defun block->0 ( blk / ent enx )
   (cond
       (   (member blk lst))
       (   (setq ent (tblobjname "block" blk))
         (while (setq ent (entnext ent))
               (entmod (subst-append 62 0 (setq enx (entget ent))))
               (if (= "INSERT" (cdr (assoc 0 enx)))
                   (block->0 (cdr (assoc 2 enx)))
               )
         )
         (setq lst (cons blk lst))
       )
   )
)
(defun subst-append ( key val lst / itm )
   (if (setq itm (assoc key lst))
       (subst (cons key val) itm lst)
       (append lst (list (cons key val)))
   )
)
 
我很高兴你发现这个程序很有用！

查看完整版本: Lee Mac lisp修改-Ke