【悬赏5明经币求程序】求"选择颜色分层"的lisp
本帖最后由 ninja37 于 2024-3-20 15:51 编辑以下这个程序 需要选择4次，
第1次ssget把图元移动到图层d000qing
第2次ssget 把把图元移动到图层D007RED
第3次ssget 把把图元移动到图层D010GREEN
第4次ssget 把把图元移动到图层D015BLUE
请哪位大师帮忙写一个只需要选择1个选择，只需要选择1次然后再分到4个图层
(defun C:LHmovelayer452030dEshuo()
(princ "\n 【45DS】 选择图元 ")
(setvar "cmdecho" 0)
(setq DATE1 (GETVAR "millisecs" ))
(command "UCS""W")(setvar "orthomode" 0)(setvar "osmode" 0) (setvar "luprec"4)
(command "-layer" "u" "*" "") ;图层全部解锁
(if (not (tblsearch "layer" "D000QING"))(command "-layer" "n" "D000QING" "c""4" "D000QING" ""));1-
(if (not (tblsearch "layer" "D007RED")) (command "-layer" "n" "D007RED" "c""1" "D007RED" ""));1-
(if (not (tblsearch "layer" "D010GREEN")) (command "-layer" "n" "D010GREEN" "c""3" "D010GREEN" ""));3-
(if (not (tblsearch "layer" "D015BLUE"))(command "-layer" "n" "D015BLUE""c""5" "D015BLUE"""));5-
(defun color (ent / c62 ent1)
(setq ent1 (entget ent))
(if (setq c62 (cdr (assoc 62 ent1)))
(if (= 0 c62)
7
c62
)
(cdr (assoc62 (entget (tblobjname "layer" (cdr(assoc8 ent1))))))
)
)
(setq co4)
(setq enlst (ssadd))
(princ "\n选择目标窗口: ")
(if (setq ss (ssget ))
(repeat (setq n(sslength ss)) ; fixed
(cond ((= 4 (color (setq x (ssname ss (setq n (1- n)))))) (ssadd x enlst)))
))
(sssetfirst nil enlst)
(command "change" ENLST "" "P" "la" "D000QING" "c" "bylayer" "")
(setq co3)
(setq co1)
(setq enlst (ssadd))
(princ "\n选择目标窗口: ")
(if (setq ss (ssget ))
(repeat (setq n(sslength ss)) ; fixed
(cond ((= 1 (color (setq x (ssname ss (setq n (1- n)))))) (ssadd x enlst)))
))
(sssetfirst nil enlst)
(command "change" ENLST "" "P" "la" "D007RED" "c" "bylayer" "")
(setq co3)
(setq enlst (ssadd))
(princ "\n选择目标窗口: ")
(if (setq ss (ssget ))
(repeat (setq n(sslength ss)) ; fixed
(cond ((= 3 (color (setq x (ssname ss (setq n (1- n)))))) (ssadd x enlst)))
))
(sssetfirst nil enlst)
(command "change" ENLST "" "P" "la" "D010GREEN" "c" "bylayer" "")
(setq co5)
(setq enlst (ssadd))
(princ "\n选择目标窗口: ")
(if (setq ss (ssget ))
(repeat (setq n(sslength ss)) ; fixed
(cond ((= 5 (color (setq x (ssname ss (setq n (1- n)))))) (ssadd x enlst)))
))
(sssetfirst nil enlst)
(command "change" ENLST "" "P" "la" "D015BLUE" "c" "bylayer" "")
(setq DATE2 (GETVAR "millisecs" ))
(PRINC (STRCAT "图元分类 耗时" (RTOS (/ (- DATE2 DATE1 ) 1000.0 ) 2 2 ) "秒。" ) ) (PRINC "\n【45XM】 所有图元已分类完成" )
(princ)
(setvar "cmdecho" 1)
(princ )
);end defun
搜一下论坛很多按颜色选择代码，注意随层颜色对象的处理，归层后的颜色处理也要考虑 start4444 发表于 2024-3-20 18:25
搜一下论坛很多按颜色选择代码，注意随层颜色对象的处理，归层后的颜色处理也要考虑
【群主】陌路相逢 已经解决就发给你吧
页:
[1]