[日积月累]：有用的lisp小工具（5）--按颜色设置物体所在层

841594

前面贴出了几个小程序，反响很不热烈*-*a ，不过我要坚持下去，精彩的还在后面：

有时候会接到autocad初学者（或习惯不好的）画的资料图，物体不是按层放置，而是改了颜色，这样的图改起来很麻烦。
下面的程序按颜色搜索图中的物体，可以把带颜色的物体移到指定的层上，可以创建新层存放这些物体。物体移动之后，颜色将被改为"bylayer"。

(defun c:hs( / cc ss n e lay clist kk)
(setq clist (list 255))
(repeat 254
   (setq clist (cons (1- (car clist)) clist))
)
(foreach cc clist
  (if (not kk)
    (princ (strcat "\n搜索物体中... 颜色 " (itoa cc)))
    (progn
     (repeat kk (princ "\010"))
     (princ (itoa cc))
    )
  )
  (setq kk (strlen (itoa cc)))
  (setq ss (ssget "x" (list (cons 62 cc))))
  (if ss (progn
    (setq kk nil)
    (setq n 0)
    (while (setq e (ssname ss n)) ;highlight the objects
      (redraw e 3)
      (setq n (1+ n))
    ) ;while
    (setq lay (getstring (strcat "\n请为颜色为 " (itoa cc) " 的物体指定层名: ")))
    (if (tblsearch "LAYER" lay)
      (command "chprop" ss "" "c" "bylayer" "layer" lay "")
      (progn
        (setq yn (getint "\n指定的层不存在. \n键入任意数字创建此层<跳过>: "))
        (if yn
          (command "layer" "m" lay "c" cc "" "" "chprop" ss "" "c" "bylayer" "layer" lay "")
        )
      ) ;progn
    ) ;if
  )) ;if
) ;foreach
) ;end

zuicai

主要是你发布的地方不对，应该发在Lisp编程板块，那样反响会热烈的多。

liberal520

不错的插件哈 谢谢分享哈