[LISP函数]：强有力的颜色过滤器..

舟自横 · 发表于 2005-4-9 15:40:45

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[PHP]
(defun hy_leachcolorlist(en / eno color layer ccolor cord_laye layerlist
         layerlist1 layername layercolor needlis);;;;參照物體顏色?/font>^濾表
(SETQ  needlis NIL)
  (if (= (type en) 'ENAME)
  (progn
  (setq eno (vlax-ename->vla-object en))
  (setq color (vla-get-color eno))
  (setq layer (vla-get-layer eno))
  (setq ccolor (cdr(assoc 62 (entget(tblobjname "layer" layer)))))
  (setq cord_layer (tblnext "layer" t))
  (setq layerlist nil layerlist1 nil)
  (while cord_layer
(setq layername (cdr(assoc 2 cord_layer)))
(setq layercolor (cdr(assoc 62 cord_layer)))
(if (= layercolor color)(setq layerlist (cons (cons 8 layername) layerlist)))
(if (= layercolor ccolor)(setq layerlist1 (cons (cons 8 layername) layerlist1)))
(setq cord_layer (tblnext "layer"))
)
  (if (/= color 256)
   (setq needlis (append '((-4 . "<or"))
         (list(cons 62 color))
         '((-4 . "<and")(62 . 256)(-4 . "<or"))
         (append layerlist  (list(cons 62 color)) )
         '((-4 . "or>")(-4 . "and>")(-4 . "or>"))))
   (setq needlis (append '((-4 . "<or"))
                  (list '(-4 . "<and")(cons 8 layer)'(62 . 256)'(-4 . "and>"))
               (list(cons 62 ccolor))
            '((-4 . "<and")(62 . 256)(-4 . "<or"))
            layerlist1
            '((-4 . "or>")(-4 . "and>")(-4 . "or>"))
            ))
      )
  ))
  (if (= (type en) 'INT) (progn
  (setq color EN)
  (setq cord_layer (tblnext "layer" t))
  (setq layerlist nil)
  (while cord_layer
(setq layername (cdr(assoc 2 cord_layer)))
(setq layercolor (cdr(assoc 62 cord_layer)))
(if (= layercolor color)(setq layerlist (cons (cons 8 layername) layerlist)))
(setq cord_layer (tblnext "layer"))
)
  (if (/= color 256)
   (setq needlis (append '((-4 . "<or"))
         (list(cons 62 color))
         '((-4 . "<and")(62 . 256)(-4 . "<or"))
         (append layerlist  (list(cons 62 color)) )
         '((-4 . "or>")(-4 . "and>")(-4 . "or>"))))
      )
  ))
  needlis
  )
[/PHP]
需要建立以参照物的颜色选择集过滤
(SSGET (hy_leachcolorlist(CAR(ENTSEL "\n请选择参照物:"))))
需要建立以2#色选择集过滤
(SSGET (hy_leachcolorlist 2))
只要颜色一样不管是否随层全部选中

啵浪鼓 · 发表于 2005-4-9 22:43:33

经测试，程序可用，但仍有一点小小小的问题需改善：
1，当只有图层0而无其它图层时，程序出错：
Command: ec
请选择参照物:erase
Select objects:
Command: EC Unknown command "EC". Press F1 for help.
Command: nil
2，当只有0层有物体时而其它图层为空时，仍提示上列错误，但如在其它层上加一根线，程序通过

应该不是我在你的程序前加上调用命令及删除记忆中的色#导致上列问题吧？？？
(defun c:ec ()
(setq s(SSGET (hy_leachcolorlist(CAR(ENTSEL "\n请选择参照物:")))))
(command "erase" s "")
)
(defun hy_leachcolorlist(en / eno color layer ccolor cord_laye layerlist
layerlist1 layername layercolor needlis)..........

舟自横 · 发表于 2005-4-10 10:15:09

呵呵..是有这种情况..没有考虑到
是一个BUG,,现在改好了...试一下

啵浪鼓 · 发表于 2005-4-10 21:54:11

嗯，现在真够强的啦

雪山飞狐(lzh) · 发表于 2005-4-10 23:09:31

不用or，用逗号分割要好些

ahill · 发表于 2005-4-12 15:25:56

不好用啊。

舟自横 · 发表于 2005-4-12 15:58:52

如果你是2000以下的版本就不好用..
如果不是的话就可以用...看看你有没有加载错误

啵浪鼓 · 发表于 2005-4-14 00:24:19

程序经测试，仍有需要改良的地方：
如果参照物體顏色为bylayer，那将删除所选物体为bylayer的颜色全部选中。。。

程序应该分析参照物为随层,就查询相应层的信息,得到本来的颜色来定义之?!

舟自横 · 发表于 2005-4-14 11:18:39

我再看看...
经过我的测试也不存在你所说的
情况啊?我的过滤方法是:
只要颜色一致不管是否随层全部可以
被选中...
注意"只要是颜色一致"..
也就是说你参照物是什么颜色(如果为随层就为
该层的颜色)
就可以选择此颜色
的所有物体包括随层的物体(随层的颜色是和参照物
颜色一致)

MJJ3468 · 发表于 2005-4-14 17:09:41

最初由舟自横发布
[B][PHP]
(defun hy_leachcolorlist(en / eno color layer ccolor cord_laye layerlist
         layerlist1 layername layercolor needlis);;;;參照物體顏色?/font>^濾表
  (if (= (type en) 'ENAME)
  (pr... [/B]

加载后,不能使用啊.能否做一个完整的程序.期待之中

舟自横 · 发表于 2005-4-14 20:36:22

[PHP]
不会吧这个这么简单还要写吗?
(DEFUN C:ESCOLOR(/ FILTER SS KEYWORD )
  (SETQ FILTER  (hy_leachcolorlist (CAR(ENTSEL "\n请选择颜色参照物体.."))))
  (PROMPT "\n请选择需要操作的物体..")
  (SETQ SS (SSGET FILTER))
  (INITGET "1 2 3 ")
(SETQ KEYWORD (GETKWORD "\n删除(1),复制(2),移动(3)..(1?)"))
(IF (=  KEYWORD NIL) (SETQ KEYWORD  "1"))
(COND ((= KEYWORD  "1") (SETQ CMD "._ERASE"))
         ((= KEYWORD  "2") (SETQ CMD "._COPY"))
         ((= KEYWORD  "3") (SETQ CMD "._MOVE"))
         )
(IF (NOT(=  KEYWORD  "1") )
(COMMAND CMD SS "" PAUSE)
(COMMAND CMD SS "" ))
(PRIN1)
)
和上面的子程序一起加载就可以了.
[/PHP]

yubm · 发表于 2005-4-15 00:26:10

不实用

啵浪鼓 · 发表于 2005-4-19 00:01:02

最初由啵浪鼓发布
[B]程序经测试，仍有需要改良的地方：
如果参照物體顏色为bylayer，那将删除所选物体为bylayer的颜色全部选中。。。

程序应该分析参照物为随层,就查询相应层的信息,得到本来的颜色来定义之?! [/B]

难怪我会出现上面的错误了，仔细验证后，原来是在选参照物时没有选择到物体，（而信息栏中无任何提示是否选择到物体）也就是此时参照物为空，如果再选择物体而导致选中所有了。

楼主应该加上提示参照物是否有选择到，如果没选择到应设置继续选择或是平静退出。（如果是选择平静退出不要出现任何出错的信息，现在好怕那种出错退出的字眼~！好像lisp还没有平静退出的程序）

所以在程序前言中加写一段不选中继续选之。。。不知可好？

(while (not (SETQ FILTER (hy_leachcolorlist (CAR(ENTSEL "\n请选择颜色参照物体..")))))
(princ)
(setq FILTER nil)
)

舟自横 · 发表于 2005-4-19 09:00:59

这样不是很好..当你选择错误时还是会错..
(while (not (SETQ FILTER (hy_leachcolorlist (CAR(ENTSEL "\n请选择颜色参照物体..")))))
(SETQ FILTER (hy_leachcolorlist (CAR(ENTSEL "\n参照物不存在,请重新选择颜色参照物体.."))))
)

狂刀 · 发表于 2005-4-19 12:51:20

(while(not (or(setq el (entsel))
(....)
))
)
(if el (progn ...)
nil
)
给个框架，自己填空．
实现：１，选中物体，跳出
　　　２，没有选中，循环
　　　３，回车，跳出．

账号		自动登录	找回密码
密码			立即注册

[LISP函数]：强有力的颜色过滤器..

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [LISP函数]：强有力的颜色过滤器..