[求助]按颜色移动的lsp

luyu9635 · 发表于 2007-7-16 19:40:00

cad2004中如何做一个lsp文件用一个命令来按所选颜色来移动对象呀

zml84 · 发表于 2007-7-16 20:33:00

本帖最后由作者于 2007-7-16 20:40:02 编辑

(setvar "cmdecho" 1)
(defun C:TT (/ SS COL PT1)
(if (and (setq SS (entsel))
(setq COL (assoc 62 (entget (car SS))))
(setq SS (ssget "X" (list COL)))
(setq PT1 (getpoint "\n基点: ")
)
)
(command "_.MOVE" SS "" "non" PT1 PAUSE)
)
(princ)
)

由于对象组码中对颜色的表达是不完善的，所以对颜色随层的对象无法支持。（需要特殊判断）

zml84 · 发表于 2007-7-16 21:11:00

按照颜色、图层、对象类型等移动对象，参见：

http://www.acad.net.cn/viewthread.php?tid=200&page=1&extra=page%3D1

只要你有足够创意，就能玩出足够精彩。这就是lisp

luyu9635 · 发表于 2007-7-18 18:01:00

谢谢楼上的，不知道你有调试过没有呀，出错了呀，即使在颜色不随层的情况下也不能正常运行呀，请再改改

7686599 · 发表于 2007-7-18 20:14:00

唉，帖一个。
如果是随块，则是按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)
)
)
)

(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)
    )
  )
)

luyu9635 · 发表于 2007-7-20 20:24:00

谢谢，请问你第一个程序中的“non"是什么意思，干什么用的呀

Andyhon · 发表于 2007-7-20 21:08:00

(command "_.MOVE" SS "" "non" PT1 PAUSE)

"non" = none ==> 解除捕捉

如此方能确认 PT1 就定位

zml84 · 发表于 2007-7-21 11:11:00

请问楼主：2、3楼代码，不能用是何种情况？

carrot1983 · 发表于 2007-7-21 13:08:00

http://co.163.com/forum/content/1680_792351_1.htm
http://co.163.com/forum/content/1680_751421_1.htm
http://co.163.com/forum/content/1680_792360_1.htm
楼主真的很了解这方面的内容。。。。都是同样的问题

luyu9635 · 发表于 2007-7-21 21:58:00

各位大侠，请不要怕麻烦，问题一直没有解决，很多方法我都试过了，我是新手，自已又不太懂这方面，所以老是提同一个问题，想借鉴大家的经验帮忙，提高自已，一起进步，谢谢

账号		自动登录	找回密码
密码			注册