高手帮忙，按颜色
高手帮帮我，现有一段Lisp代码，功能是按颜色移动对象。我想改为按颜色选择对象，且可以框选。;;http://bbs.mjtd.com/thread-61591-1-1.html;;如果是随块，则是按7号色选择对象
(defun c:x1 (/ *laysel* cor en lay-lst lay-str obj pt ss)
(setq *laysel* (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(if (and (setq en (car (entsel "\n选择目标对象:")))
(setq obj (vlax-ename->vla-object en))
(setq cor (vla-get-color obj))
(setq pt (getpoint "\n基点:"))
)
(progn
;; 分辨颜色
(cond ((= cor 256) ;_ 随层
(setq cor (vla-get-color (vla-item *laysel* (vla-get-layer obj))))
)
((= cor 0) ;_ 随块
(setq cor 7)
)
)
;; 筛选图层
(vlax-for lay *laysel*
(if (= (vla-get-color lay) cor)
(setq lay-lst (cons (vla-get-name lay) lay-lst))
)
)
(if lay-lst
(foreach lay lay-lst
(if lay-str
(setq lay-str (strcat lay-str "," lay))
(setq lay-str lay)
)
)
)
;; 形成选择集
(if lay-str
(setq ss (ssget "x" (list '(-4 . "<OR") (cons 0 lay-str) (cons 62 cor) '(-4 . "OR>"))))
(setq ss (ssget "x" (list (cons 62 cor))))
)
(vl-cmdf "move" ss "" pt)
(vl-cmdf pause)
)
)
)
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=86610 自贡黄明儒 发表于 2013-5-23 15:58 static/image/common/back.gif
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=86610
谢谢长老，帮我大忙了
页:
[1]