好久没上论坛了,突发其想: 相同直径改为相同颜色

ysq101

图中有:直径1MM圆
直径2MM圆
直径3MM圆
直径4MM圆
直径5MM圆
直径6MM圆
直径8MM圆
........... 后面还有还有很多
各2到50个  个数未知

能不能分别将  同直径的圆   改为红黄绿青等颜色
即相同直径的圆改为相同颜色

ysq101

来点思路:
先建几个空选择集
搜索组码表 10
IF    组码表 10  =  1
将它加入选集1

IF    组码表 10  = 2
将它加入选集2

IF    组码表 10  = 3
将它加入选集3

..................

分别将选择集1 2 3 4 .....
改颜色

还有什么更好的方法吗?

问题是不知道需要建几个选择集

newer

组吗表10是什么？ 10是点啊，你不是要过滤出半径吗？ 遍历选择集，把相同半径的放到一个子表里面，然后处理就OK了。

newer

就一个选择集就够了，用关联表，把面积一样的都放一个关联表里面。下面是演示代码

1. (defun c:tt()
   
2.    (if (setq ss (ssget '((0 . "CIRCLE"))))
   
3.       (progn
   
4.          (xdrx_undostart)
   
5.          (xdrx_setsstodb ss 0)
   
6.          (setq entl nil)
   
7.          (while (setq e (xdrx_getentdata 0))
   
8.             (setq r (xdrx_getentdxf 40)
   
9.                   key (rtos r 2 2)
   
10.                   old (assoc key entl)
    
11.             )
    
12.             (if old
    
13.                (setq entl (subst (append (list key) (cons e (cdr old))) old entl))
    
14.                (setq entl (cons (list key e) entl))
    
15.             )
    
16.          )
    
17.          (setq i 0)
    
18.          (foreach n entl
    
19.             (setq i (1+ i))
    
20.             (mapcar '(lambda(x) (xdrx_setpropertyvalue x "color" i)) n)
    
21.          )
    
22.          (xdrx_undoend)
    
23.       )
    
24.    )
    
25.    (princ)
    
26. )
    
27. 
    

(defun c:tt()<br />    (if (setq ss (ssget '((0 . "CIRCLE"))))<br />       (progn<br />          (xdrx_undostart)<br />          (xdrx_setsstodb ss 0)<br />          (setq entl nil)<br />          (while (setq e (xdrx_getentdata 0))<br />             (setq r (xdrx_getentdxf 40)<br />                   key (rtos r 2 2)<br />                   old (assoc key entl)<br />             )<br />             (if old<br />                (setq entl (subst (append (list key) (cons e (cdr old))) old entl))<br />                (setq entl (cons (list key e) entl))<br />             )<br />          )<br />          (setq i 0)<br />          (foreach n entl<br />             (setq i (1+ i))<br />             (mapcar '(lambda(x) (xdrx_setpropertyvalue x "color" i)) n)<br />          )<br />          (xdrx_undoend)<br />       )<br />    )<br />    (princ)<br /> )<br /> <br />

ysq101

newer 发表于 2013-10-3 23:44
就一个选择集就够了，用关联表，把面积一样的都放一个关联表里面。下面是演示代码

汗...高手就是高手..还没两下子就搞定了...
用好了通用函数就是快啊.....可惜我到现在还是没搞明白   子函数是如何传递的

谢谢你给的思路   还是得自己写一下纯LISP的源码的

最后更正一下:应该是组码40    而不是10

ysq101

newer 发表于 2013-10-3 23:27
组吗表10是什么？ 10是点啊，你不是要过滤出半径吗？ 遍历选择集，把相同半径的放到一个子表里面，然后处理 ...

没看你是写程序啊
完全就是在   堆砌   程序嘛

st788796

ysq101 发表于 2013-10-4 00:45
没看你是写程序啊
完全就是在   堆砌   程序嘛

Lisp 也可以啊

1. (defun XD::LIST:SameIndex1 (lst / ll l)
   
2.   (foreach x lst
   
3.     (if ll
   
4.       (if (setq l (assoc (car x) ll))
   
5. (setq ll (subst (cons (car l) (cons x (cdr l)))
   
6.    (assoc (car x) ll)
   
7.    ll
   
8.    )
   
9. )
   
10. (setq ll (append (list (list (car x) x)) ll))
    
11.       )
    
12.       (setq ll (list (list (car x) x)))
    
13.     )
    
14.   )
    
15.   (mapcar 'cdr ll)
    
16. )
    
17. (defun c:tt (/ ss sl i el ll)
    
18.   (if (setq ss (ssget '((0 . "circle"))))
    
19.     (progn
    
20.       (setq sl (sslength ss)
    
21.      i  -1
    
22.       )
    
23.       (repeat sl
    
24. (setq el (entget (ssname ss (setq i (1+ i))))
    
25.        ll (cons (list (rtos (cdr (assoc 40 el)) 2 8) el) ll)
    
26. )
    
27.       )
    
28.       (setq i 1)
    
29.       (foreach x (XD::LIST:SameIndex1 ll)
    
30. (foreach a x
    
31.    (entmod (append (cadr a) (list (cons 62 i))))
    
32. )
    
33. (setq i (1+ i))
    
34.       )
    
35.     )
    
36.   )
    
37.   (princ)
    
38. )

(defun XD::LIST:SameIndex1 (lst / ll l)<br />   (foreach x lst<br />     (if ll<br />       (if (setq l (assoc (car x) ll))<br /> (setq ll (subst (cons (car l) (cons x (cdr l)))<br />    (assoc (car x) ll)<br />    ll<br />    )<br /> )<br /> (setq ll (append (list (list (car x) x)) ll))<br />       )<br />       (setq ll (list (list (car x) x)))<br />     )<br />   )<br />   (mapcar 'cdr ll)<br /> )<br /> (defun c:tt (/ ss sl i el ll)<br />   (if (setq ss (ssget '((0 . "circle"))))<br />     (progn<br />       (setq sl (sslength ss)<br />      i  -1<br />       )<br />       (repeat sl<br /> (setq el (entget (ssname ss (setq i (1+ i))))<br />        ll (cons (list (rtos (cdr (assoc 40 el)) 2 8) el) ll)<br /> )<br />       )<br />       (setq i 1)<br />       (foreach x (XD::LIST:SameIndex1 ll)<br /> (foreach a x<br />    (entmod (append (cadr a) (list (cons 62 i))))<br /> )<br /> (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (princ)<br /> )

xyp1964

2. ;; 云共享 http://yunpan.cn/QXQKsW9gAPmpF
   
3. (defun c:tt ()
   
4.   (princ "\n选择圆实体: ")
   
5.   (if (setq ss (ssget '((0 . "CIRCLE"))))
   
6.     (progn
   
7.       (setq lst        (xyp-ss2list ss)
   
8.             lst        (mapcar '(lambda (x) (list (xyp-DXF 40 x) x)) lst)
   
9.             lst        (vl-sort lst '(lambda (x y) (< (car x) (car y))))
   
10.             r0        (caar lst)
    
11.             i        1
    
12.       )
    
13.       (foreach a lst
    
14.         (setq r1 (car a))
    
15.         (if (not (equal r0 r1))
    
16.           (setq        r0 r1
    
17.                 i  (1+ i)
    
18.           )
    
19.         )
    
20.         (xyp-SubUpd (cadr a) 62 i)
    
21.       )
    
22.     )
    
23.   )
    
24.   (princ)
    
25. )

;; 云共享 http://yunpan.cn/QXQKsW9gAPmpF<br /> (defun c:tt ()<br />   (princ "\n选择圆实体: ")<br />   (if (setq ss (ssget '((0 . "CIRCLE"))))<br />     (progn<br />       (setq lst        (xyp-ss2list ss)<br />             lst        (mapcar '(lambda (x) (list (xyp-DXF 40 x) x)) lst)<br />             lst        (vl-sort lst '(lambda (x y) (< (car x) (car y))))<br />             r0        (caar lst)<br />             i        1<br />       )<br />       (foreach a lst<br />         (setq r1 (car a))<br />         (if (not (equal r0 r1))<br />           (setq        r0 r1<br />                 i  (1+ i)<br />           )<br />         )<br />         (xyp-SubUpd (cadr a) 62 i)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

st788796

xyp1964 发表于 2013-10-4 11:00

以院长这种封装函数，得到lst后直接用(vl-sort lst '(lambda (e1 e2 )(< (xpy-dxf e1) (xyp-dxf e2))) )

xyp1964

2. (defun c:test1372 ()
   
3.   (princ "\n选择圆实体: ")
   
4.   (if (setq ss (ssget '((0 . "CIRCLE"))))
   
5.     (progn
   
6.       (setq lst        (xyp-ss2list ss)
   
7.             lst        (vl-sort lst '(lambda (x y) (< (xyp-DXF 40 x) (xyp-DXF 40 y))))
   
8.             r0        (xyp-DXF 40 (car lst))
   
9.             i        1
   
10.       )
    
11.       (foreach s1 lst
    
12.         (setq r1 (xyp-DXF 40 s1))
    
13.         (if (not (equal r0 r1))
    
14.           (setq        r0 r1
    
15.                 i  (1+ i)
    
16.           )
    
17.         )
    
18.         (xyp-SubUpd s1 62 i)
    
19.       )
    
20.     )
    
21.   )
    
22.   (princ)
    
23. )

(defun c:test1372 ()<br />   (princ "\n选择圆实体: ")<br />   (if (setq ss (ssget '((0 . "CIRCLE"))))<br />     (progn<br />       (setq lst        (xyp-ss2list ss)<br />             lst        (vl-sort lst '(lambda (x y) (< (xyp-DXF 40 x) (xyp-DXF 40 y))))<br />             r0        (xyp-DXF 40 (car lst))<br />             i        1<br />       )<br />       (foreach s1 lst<br />         (setq r1 (xyp-DXF 40 s1))<br />         (if (not (equal r0 r1))<br />           (setq        r0 r1<br />                 i  (1+ i)<br />           )<br />         )<br />         (xyp-SubUpd s1 62 i)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

ysq101

st788796 发表于 2013-10-4 01:47
Lisp 也可以啊

谢谢你的分享,,,我自己再研究一下...不懂的请指教一下

ngc

我用了cad自带的快速选择的功能，可以看看

批量改颜色

Lisphk

ngc 发表于 2013-10-7 09:05
我用了cad自带的快速选择的功能，可以看看

这样一次只能选一个种类的半径吧，如果图中有很多半径，要一个一个的去这样做吧？

小陶

方法没院长的高明！结果一样！加了个统计表格。

ysq101

小陶 发表于 2013-10-11 11:16
方法没院长的高明！结果一样！加了个统计表格。

同行呀/???能分享一下源码吗??