高手帮忙，按颜色

dforme

高手帮帮我，现有一段Lisp代码，功能是按颜色移动对象。我想改为按颜色选择对象，且可以框选。

2. ;;http://bbs.mjtd.com/thread-61591-1-1.html
   
3. ;;如果是随块，则是按7号色选择对象
   
4. (defun c:x1 (/ *laysel* cor en lay-lst lay-str obj pt ss)
   
5.   (setq *laysel* (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
   
6.   (if (and (setq en (car (entsel "\n选择目标对象:")))
   
7.     (setq obj (vlax-ename->vla-object en))
   
8.     (setq cor (vla-get-color obj))
   
9.     (setq pt (getpoint "\n基点:"))
   
10.       )
    
11.     (progn
    
12.       ;; 分辨颜色
    
13.       (cond ((= cor 256) ;_ 随层
    
14.       (setq cor (vla-get-color (vla-item *laysel* (vla-get-layer obj))))
    
15.      )
    
16.      ((= cor 0) ;_ 随块
    
17.       (setq cor 7)
    
18.      )
    
19.       )
    
20.       ;; 筛选图层
    
21.       (vlax-for lay *laysel*
    
22. (if (= (vla-get-color lay) cor)
    
23.    (setq lay-lst (cons (vla-get-name lay) lay-lst))
    
24. )
    
25.       )
    
26.       (if lay-lst
    
27. (foreach lay lay-lst
    
28.    (if lay-str
    
29.      (setq lay-str (strcat lay-str "," lay))
    
30.      (setq lay-str lay)
    
31.    )
    
32. )
    
33.       )
    
34.       ;; 形成选择集
    
35.       (if lay-str
    
36. (setq ss (ssget "x" (list '(-4 . "<OR") (cons 0 lay-str) (cons 62 cor) '(-4 . "OR>"))))
    
37. (setq ss (ssget "x" (list (cons 62 cor))))
    
38.       )
    
39.       (vl-cmdf "move" ss "" pt)
    
40.       (vl-cmdf pause)
    
41.     )
    
42.   )
    
43. )
    

;;http://bbs.mjtd.com/thread-61591-1-1.html<br /> ;;如果是随块，则是按7号色选择对象<br /> (defun c:x1 (/ *laysel* cor en lay-lst lay-str obj pt ss)<br />   (setq *laysel* (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))<br />   (if (and (setq en (car (entsel "\n选择目标对象:")))<br />     (setq obj (vlax-ename->vla-object en))<br />     (setq cor (vla-get-color obj))<br />     (setq pt (getpoint "\n基点:"))<br />       )<br />     (progn<br />       ;; 分辨颜色<br />       (cond ((= cor 256) ;_ 随层<br />       (setq cor (vla-get-color (vla-item *laysel* (vla-get-layer obj))))<br />      )<br />      ((= cor 0) ;_ 随块<br />       (setq cor 7)<br />      )<br />       )<br />       ;; 筛选图层<br />       (vlax-for lay *laysel*<br /> (if (= (vla-get-color lay) cor)<br />    (setq lay-lst (cons (vla-get-name lay) lay-lst))<br /> )<br />       )<br />       (if lay-lst<br /> (foreach lay lay-lst<br />    (if lay-str<br />      (setq lay-str (strcat lay-str "," lay))<br />      (setq lay-str lay)<br />    )<br /> )<br />       )<br />       ;; 形成选择集<br />       (if lay-str<br /> (setq ss (ssget "x" (list '(-4 . "<OR") (cons 0 lay-str) (cons 62 cor) '(-4 . "OR>"))))<br /> (setq ss (ssget "x" (list (cons 62 cor))))<br />       )<br />       (vl-cmdf "move" ss "" pt)<br />       (vl-cmdf pause)<br />     )<br />   )<br /> )<br />

自贡黄明儒

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=86610

dforme

自贡黄明儒 发表于 2013-5-23 15:58
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=86610

谢谢长老，帮我大忙了