[求助]提出个想法，可以编出个按颜色选择物体的程序吗？

userzhl

高手都跑哪里去了，问题还没解决呢。

别晨

;_________________________________________________________________________
;
;                     Program  ls_selectobjbycolor
;
;              Author : 别晨    11:47 AM 2006-3-13
;________________________________________________________________________
;
;根据颜色选定物体,可逐个选取多种颜色，右键结束选择
;**********************************************************************
(defun c:ls_selectobjectbycolor ( / oce osm olderr errn sbase enam crBase ss ssmid i name_i crThis )
   (graphscr)                       ;切换到图形窗口
   (setq oce (getvar "cmdecho"))    ;储存旧的指令响应值
   (setq osm (getvar "osmode"))          ;保存当前osnap设置
   (setvar "osmode" 0)                   ;不捕捉
   (setvar "cmdecho" 0)             ;关闭指令响应
   (setvar "errno" 0)               ;系统变量errno归零
   (setq olderr *error*)            ;保存原有*erroer*函数内容
   (defun *error* (msg)             ;自定义出错处理
    (setvar "cmdecho" oce)
         (setq errn (getvar "errno"))
        (princ errn)
   )
 
  (setq ss (ssadd))
  (setq ssmid (ssget "x"))
 
 ;选择一个物体以确定颜色
  (while (setq sbase (entsel "选择任意物体确定颜色："))
    (princ)
      (setq    enam (car sbase)                 
          crBase (myGetObjectColor enam)
      )
      (princ crBase)
      (setq i -1)
      (repeat (sslength ssmid)
        (setq crThis (myGetObjectColor (setq name_i (ssname ssmid (setq i (1+ i))))))
        (if (= crBase crThis )
          (progn
        (setq ss (ssadd name_i ss))
          )
        )
      )
  )
  (command ".select" ss "")
  ;此句仅仅为验证结果，使用时可去掉
  (command ".select" "p")

 
  (setq *error* olderr)　　　　　 　 ;恢复原有*error*函数内容
  (setvar "osmode" osm)             ;恢复osnap设置
  (setvar "cmdecho" oce)             ;恢复旧的指令响应值

)
;**********************************************************************

(defun myGetObjectColor( ename / nam col lay la a1 )    
     (setq nam (cdr (assoc 0 (entget ename))))   ;取得对象类型
     (setq col (cdr (assoc 62 (entget ename))))  ;取得对象颜色
     (if (= col nil)                                       ;如果颜色随层
         (progn
                 (setq lay (cdr (assoc 8 (entget ename))))         ;取得对象所在层的图层名
                 (setq la (entget (tblobjname "layer" lay)))    ;取得该图层的数据序列
                 (setq a1 (cdr (car la)))                       ;取得图层数据序列的名称(-1项)
                 (setq col (cdr (assoc 62 (entget a1))))        ;取得图层的颜色,赋予变量col
         )
     )
  col
)

别晨

对块，组，以及标注等会出现混乱

userzhl

是呀，哪们高手做出20楼附件那样的？

命令SLC和SLC1

别晨

那个附件和我的程式一样，对组、块的无能为力！～

userzhl

楼上，你的能不能增加个可以框选的？就是局部选取，就像SLC1

别晨

(setq ssmid (ssget "x"))
一句改成
(setq ssmid (ssget))

and2008

看来这个问题比较复杂噢，俺想缩小以下范围，按照颜色选中字体如何解决呀？

iamhuyuzhu

22楼的程序很好啊，就是能不能直接激活选择的对象啊，而不是添加到上一个选择集

samshs

如果再加图层区分就好啦！