Lee Mac lisp修改-Ke

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

嗨，李和其他人，

关于李的密码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

copy

(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”及其右括号完成！

copy

(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

你的修改是正确的-做得好。

以下是带有适当缩进的代码：

copy

(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

发表回复

精选推荐