【悬赏5明经币求程序】求"选择颜色分层"的lisp

ninja37

以下这个程序 需要选择4次，
第1次ssget把图元移动到图层d000qing
第2次ssget 把把图元移动到图层D007RED
第3次ssget 把把图元移动到图层D010GREEN
第4次ssget 把把图元移动到图层D015BLUE
请哪位大师帮忙写一个  只需要选择1个选择，只需要选择1次然后再分到4个图层
(defun CHmovelayer452030dEshuo  ()
        (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 (assoc  62 (entget (tblobjname "layer" (cdr(assoc  8 ent1))))))
  )
)
          (setq co  4)
  (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 "" "" "la" "D000QING" "c" "bylayer"   "")
          (setq co  3)
  (setq co  1)
  (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 "" "" "la" "D007RED" "c" "bylayer"   "")
          (setq co  3)
  (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 "" "" "la" "D010GREEN" "c" "bylayer"   "")
                  (setq co  5)
  (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 "" "" "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

搜一下论坛很多按颜色选择代码，注意随层颜色对象的处理，归层后的颜色处理也要考虑

ninja37

start4444 发表于 2024-3-20 18:25
搜一下论坛很多按颜色选择代码，注意随层颜色对象的处理，归层后的颜色处理也要考虑

【群主】陌路相逢 已经解决  就发给你吧