;; =================================================================
;;; 块替换；选择源块A，然后选择需要替换成块A的块B，再选择一个区域，然后把这个区域里的块B换成块A
;;; 作者：langjs 命令：KTH 日期2011年3月22日
;;; =================================================================
(defun C:KTH (/ ent ent1 ent2 i kming1 kming2 lst name1 name2 pt ss t1)
(setvar "cmdecho" 0) ; 关闭命令响应
(setq $orr *error*)
(setq *error* #err2) ; 当程序出错时就会执行#err函数
(command ".UNDO" "BE") ; 设置UNDO起点
(setq t1 1)
(while (= t1 1)
(setq name1 (car (entsel "\n选择源块A：")))
(setq ent1 (entget name1))
(if (= (cdr (assoc 0 ent1)) "INSERT")
(progn
(setq kming1 (cdr (assoc 2 ent1)))
(redraw name1 3)
(setq t1 2)
)
(princ "\n选择源块A：")
)
)
(while (= t1 2)
(setq name2 (car (entsel "\n选择替换块B：")))
(setq ent2 (entget name2))
(if (= (cdr (assoc 0 ent2)) "INSERT")
(progn
(setq kming2 (cdr (assoc 2 ent2)))
(redraw name2 3)
(setq t1 3)
)
(princ "\n选择替换块B：")
)
)
(while (= t1 3)
(prompt "\n选择替换区域:")
(setvar "nomutt" 1)
(setq ss (ssget (list (cons 2 kming2))))
(setvar "nomutt" 0)
(if ss
(setq t1 4)
)
)
(redraw name1 4)
(redraw name2 4)
(setq lst '())
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i))))
(setq ent (entget ent))
(setq lst (cons (cdr (assoc 10 ent)) lst))
)
(command "erase" ss "") ; 删除块
(setq i 0)
(while (< i (length lst))
(setq PT (nth i lst))
(command "INSERT" kming1 PT 1 1 0) ; 插入块，
(nth i lst)
(setq i (+ i 1))
)
(command ".UNDO" "E") ; 设置UNDO终点
(setq *error* $orr)
(princ)
)
;;; 出错处理函数
(defun #err2 (s)
(command ".UNDO" "E") ; 设置UNDO终点
(redraw name1 4)
(redraw name2 4)
(princ)
(setq *error* $orr)
)
T改T1 行吗 大神
先收藏了，好东西啊
正在学习相关块的知识
块可以直接替换块，就像格式刷一样，万物皆可刷。
贱人工具箱应该就是加入了这个功能，替换后块比例变小了
78946299 发表于 2022-4-15 18:41
块可以直接替换块，就像格式刷一样，万物皆可刷。
这是一个很牛的插件啊！
狼大哥 6666666666666666666666666666666666666666666666666666666666666666666666666
加载错误？帮忙看下