明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 570|回复: 6

[源码] 按颜色选择

[复制链接]
发表于 2018-3-12 21:39 | 显示全部楼层 |阅读模式
这个写了半天,终于写出来了,那位牛人能把我这个改精简点吗?
  1. ;按颜色选择
  2. (defun c:xyc ()
  3.   (setq txh 1)
  4.   (while txh
  5.     (setq object (entsel "\n请选过滤颜色对象"))
  6.     (if (= object nil)
  7.       nil
  8.       (setq txh nil)
  9.     )
  10.   )
  11.   (setq txh 1)
  12.   (while txh
  13.     (setq ss (ssadd))
  14.     (if (= ss nil)
  15.       nil
  16.       (setq txh nil)
  17.     )
  18.   )
  19.   (if (= (assoc 62 (entget (car object))) nil);如果图元颜色为随层
  20.     (progn
  21.       (setq object_Name (cdr (assoc 8 (entget (car object)))));提取图元图层名
  22.       (setq object_Color (cdr (assoc 62 (tblsearch "layer" object_Name))));提取图层颜色
  23.     )
  24.     (progn
  25.       (setq object_Color (cdr (assoc 62 (entget (car object)))));提取图元颜色
  26.     )
  27.   )
  28.   (setq ss1 (ssget));新建选择集
  29.   (setq xh 0)
  30.   (repeat (sslength ss1);循环选择集的每一个图元
  31.     (setq Object_Color2 (cdr (assoc 62 (entget (ssname ss1 xh)))));图元颜色
  32.     (if (= Object_Color2 nil);如果图元颜色为随层
  33.       (progn
  34.         (setq object_Name (cdr (assoc 8 (entget (ssname ss1 xh)))));提取图元图层名
  35.         (setq object_Color2 (cdr (assoc 62 (tblsearch "layer" object_Name))));提取图层颜色
  36.         (if (= object_Color2 object_Color)
  37.           (ssadd (ssname ss1 xh) ss);加入到选择集
  38.         )
  39.       )
  40.       (progn
  41.         (if (= object_Color2 object_Color)
  42.           (ssadd (ssname ss1 xh) ss);加入到选择集
  43.         )
  44.       )
  45.     )
  46.     (setq xh (+ xh 1))
  47.   )
  48.   (sssetfirst nil ss)
  49.   (princ (strcat "\n已选择" (rtos (sslength ss) 2 4) "个对象"))
  50.   (princ)
  51. )

发表于 2018-3-13 17:52 | 显示全部楼层
对象过滤还是用SSGET这个函数比较有效率,楼主不妨试试。
另外所谓的优化和程序精简是不一样的,优化后的程序比当前程序更长也是可能的。
 楼主| 发表于 2018-3-14 12:39 | 显示全部楼层
我刚开始写就是用ssget写的 但是图元为随层我就弄不好了 要取的选择图元的所有图层 再找符合颜色的图层下图元为随层的图元
我的水平就只有这样了
发表于 2018-3-14 16:30 | 显示全部楼层
本帖最后由 namezg 于 2018-3-15 18:15 编辑

  1. ;;;获取对象颜色函数
  2. ;(setq col (GetColor (setq en (car (entsel)))))
  3. (defun GetColor (en / dxf col)
  4.   (setq dxf (entget en))
  5.   (if (not (setq col (cdr (assoc 62 dxf))))
  6.     (setq col (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 dxf))))))
  7.   )
  8.   col
  9. )
  10. ;获得颜色为指定颜色的选择集(包括随层对象,包括块对象)
  11. ;col -- 颜色索引(0-256)
  12. ;(setq ss (GetColorSS (setq col 4)))
  13. (defun GetColorSS (col / Layers laystr lay ss)
  14.   (setq Layers (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
  15.   (setq laystr "")
  16.   (vlax-for item Layers
  17.     (setq lay (vla-get-Name item))
  18.     (if (= (vla-get-Color item) col)
  19.       (if (= laystr "")
  20.         (setq laystr lay)
  21.         (setq laystr (strcat laystr "," lay))
  22.       )
  23.     )
  24.   )
  25.   (if (= laystr "")
  26.     (setq ss (ssget (list (cons 62 col))))
  27.     (setq ss
  28.       (ssget
  29.         (list
  30.           '(-4 . "<OR")
  31.               (cons 62 col)
  32.               '(-4 . "<AND")
  33.                   (cons 8 laystr)
  34.                   '(62 . 256)
  35.               '(-4 . "AND>")
  36.           '(-4 . "OR>")
  37.         )
  38.       )
  39.     )
  40.   )
  41. )
  42. ;选择与指定对象颜色相同的对象(包括随层对象,包括块对象)
  43. (defun c:GetSameColorSS ( / en ss n)
  44.   (vl-load-com)
  45.   (if (setq en (car (entsel "\n请选择源对象:")))
  46.     (setq ss (GetColorSS (GetColor en)))
  47.   )
  48.   (sssetfirst nil ss)
  49.   (if ss
  50.     (setq n (sslength ss))
  51.     (setq n 0)
  52.   )
  53.   (princ (strcat "\n选择与指定对象颜色相同的对象" (rtos n 2 4) "个。"))
  54.   (princ)
  55. )

发表于 2018-3-15 08:53 | 显示全部楼层
  1. (defun c:xyc ()
  2.   (while (null (setq obj (entsel "\n请选过滤颜色对象"))))
  3.   (setq        dxf (entget (car obj))
  4.         c   (cdr (assoc 62 dxf))
  5.   )
  6.   (if (null c)                                ;如果图元颜色为随层
  7.     (setq c (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 dxf)))))) ;提取图层颜色
  8.   )
  9.   (setq        ss1 (ssget)
  10.         ss  (ssadd)
  11.   )                                        ;新建选择集
  12.   (repeat (setq xh (sslength ss1))        ;循环选择集的每一个图元
  13.     (setq dxf (entget (ssname ss1 (setq xh (1- xh))))
  14.           c2  (cdr (assoc 62 dxf))
  15.     )                                        ;图元颜色
  16.     (if        (null c2)                        ;如果图元颜色为随层
  17.       (setq c2 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 dxf)))))) ;提取图层颜色
  18.     )
  19.     (if        (= c2 c)
  20.       (ssadd (ssname ss1 xh) ss)        ;加入到选择集
  21.     )
  22.   )
  23.   (sssetfirst nil ss)
  24.   (princ (strcat "\n已选择" (itoa (sslength ss)) "个对象"))
  25.   (princ)
  26. )
 楼主| 发表于 2018-3-15 09:42 | 显示全部楼层
谢谢楼上两位的帮忙  一下看不懂  的慢慢理解  
发表于 2018-3-15 10:27 | 显示全部楼层
尒樣僮 发表于 2018-3-15 09:42
谢谢楼上两位的帮忙  一下看不懂  的慢慢理解

地板的代码是使用CAD自带的过滤选择系统,可以一次选定结果不用排查(不满足条件的对象直接无法选中)

5#代码仅演示代码精简优化(差不多少了一半的行数)
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-6-21 19:59 , Processed in 0.272689 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表