程序加个功能 ZZ版 vectra高手 过来瞧瞧 看看
论坛大神们帮忙写的一个程序非常好用 最近工作需要 加个功能加个Q向左旋转E向右旋转 旋转角度默认为90度 如果能留个设置旋转的角度就更好
以前的Q设置改为R(defun c:tt (/ _getreal gr ss str)
(defun _getreal (msg default / ret)
(setq ret (getreal (strcat msg " <" (rtos default) ">:")))
(if (null ret)
default
ret
)
)
(setvar 'cmdecho 0)
(if (null *grmovedis*)
(setq *grmovedis* 4.0)
)
(setq str "\n按W S A D 移动, Q 设置步长, 空格回车或左\右键退出:")
(princ (strcat "\n步长 = " (rtos *grmovedis* 2) ""))
(if (setq ss (ssget))
(progn (princ str)
(while (and (/= (car (setq gr (grread t 15 0))) 3)
(not (equal gr '(2 32)))
(not (equal gr '(2 13)))
(not (equal gr '(11 0)))
(not (equal gr '(25 0)))
)
(cond ((or (equal gr '(2 119)) (equal gr '(2 87))) ;wW
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) *grmovedis*))
)
((or (equal gr '(2 83)) (equal gr '(2 115))) ;Ss
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) *grmovedis*))
)
((or (equal gr '(2 65)) (equal gr '(2 97))) ;Aa
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi *grmovedis*))
)
((or (equal gr '(2 68)) (equal gr '(2 100))) ;Dd
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 *grmovedis*))
)
((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq
(setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))
(princ str)
)
)
)
)
)
(setvar 'cmdecho 1)
(princ)
) 本帖最后由 vectra 于 2014-12-21 08:23 编辑
求形心函数改自Z版，特此声明
同时修改了移位后重新计算形心，以保持以选择集中心旋转。
(defun c:tt (/ _getreal _getpoint gr ss str)
(defun _getreal (msg default / ret)
(setq ret (getreal (strcat msg " <" (rtos default) ">:")))
(if (null ret)
default
ret
)
)
(defun _getpoint (ss / a b i m1 m2 p1 p2)
(repeat (setq i (sslength ss))
(vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
)
(if (null m1)
(setq m1 p1)
(setq m1 (mapcar 'min m1 p1))
)
(if (null m2)
(setq m2 p2)
(setq m2 (mapcar 'max m2 p2))
)
)
(mapcar '(lambda (a b) (/ (+ a b) 2)) m1 m2)
)
(setvar 'cmdecho 0)
(if (null *grmovedis*)
(setq *grmovedis* 4.0)
)
(if (null *grangles*)
(setq *grangles* 90.0)
)
(setq str "\n按W S A D 移动, Q向左旋转, E向右旋转 R设置步长 T设置角度, 空格回车或左\右键退出:")
(princ (strcat "\n步长 = " (rtos *grmovedis* 2) ""))
(if (setq ss (ssget))
(progn (princ str)
(while (and (/= (car (setq gr (grread t 15 0))) 3)
(not (equal gr '(2 32)))
(not (equal gr '(2 13)))
(not (equal gr '(11 0)))
(not (equal gr '(25 0)))
)
(cond ((or (equal gr '(2 119)) (equal gr '(2 87))) ;wW
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) *grmovedis*))
)
((or (equal gr '(2 83)) (equal gr '(2 115))) ;Ss
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) *grmovedis*))
)
((or (equal gr '(2 65)) (equal gr '(2 97))) ;Aa
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi *grmovedis*))
)
((or (equal gr '(2 68)) (equal gr '(2 100))) ;Dd
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 *grmovedis*))
)
((or (equal gr '(2 69)) (equal gr '(2 101))) ;Ee
(vl-cmdf "_.rotate" ss "" (_getpoint ss) (- *grangles*))
)
((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq
(vl-cmdf "_.rotate" ss "" (_getpoint ss) *grangles*)
)
((or (equal gr '(2 82)) (equal gr '(2 114))) ;Rr
(setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))
(princ str)
)
((or (equal gr '(2 84)) (equal gr '(2 116))) ;Tt
(setq *grangles* (abs (_getreal "\n输入每次旋转的角度" *grangles*)))
(princ str)
)
)
)
)
)
(setvar 'cmdecho 1)
(princ)
)
此码的原作者是谁？ lucas_3333 发表于 2014-12-20 19:59 static/image/common/back.gif
此码的原作者是谁？
zzz版 怎么了？ lucas_3333 发表于 2014-12-20 19:59 static/image/common/back.gif
此码的原作者是谁？
vectra他帮忙修改过一次 啥问题 大哥 love1030312 发表于 2014-12-20 20:01 static/image/common/back.gif
vectra他帮忙修改过一次 啥问题 大哥
如果是这样，何不在原贴下面跟贴呢？然后给Z版或vectra大侠一个消息，如果大家在论坛看到一个程序，这个想这样改，那个想那样改，都发新主题，那样不是不利于查找？
楼上说的有理有据. 本帖最后由 ZZXXQQ 于 2014-12-21 07:43 编辑
;ZZXXQQ 2014.6.29 2014.12.21
(defun c:tt(/ GR SS ds str)
(setvar 'cmdecho 0)
;(setq ds 4.0)
;(setq ds (if (numberp ds) ds 4.0));2014.11.16
;(setq rd (if (numberp rd) rd 90.0))
(setq ds (if (setq ds (getdist "\n移动步长: ")) ds 4.0))
(setq rd (if (setq rd (getreal "\n旋转角度: ")) rd 90.0))
(setq str "按W S A D 移动,Q左旋,E右旋,空格回车左\右键退出:")
(if (setq ss (ssget)) (progn
(setq pt1 (list 1e6 1e6) pt2 (list -1e6 -1e6))
(repeat (setq i (sslength ss))
(setq en (ssname ss (setq i (1- i))))
(vla-GetBoundingBox (vlax-ename->vla-object en) 'p1 'p2)
(setq p1 (vlax-safearray->list p1))
(setq p2 (vlax-safearray->list p2))
(setq pt1 (mapcar 'min pt1 p1))
(setq pt2 (mapcar 'max pt2 p2))
)
(setq pc (mapcar '(lambda (a b) (/ (+ a b) 2)) pt1 pt2))
(princ (strcat "\n" str "距离" (rtos ds 2)))
(while (and (/= (car (setq gr(grread t 15 0)))3)
(not(equal gr '(2 32)))
(not(equal gr '(2 13)))
(not(equal gr '(11 0)))
(not(equal gr '(25 0))))
(cond
((or (equal gr '(2 119))(equal gr '(2 87)))
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) ds))
(prompt (strcat "\r" str "向上移动"))
)
((or (equal gr '(2 83))(equal gr '(2 115)))
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) ds))
(prompt (strcat "\r" str "向下移动"))
)
((or (equal gr '(2 65))(equal gr '(2 97)))
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi ds))
(prompt (strcat "\r" str "向左移动"))
)
((or (equal gr '(2 68))(equal gr '(2 100)))
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 ds))
(prompt (strcat "\r" str "向右移动"))
)
((or (equal gr '(2 81))(equal gr '(2 113))) ;Qq
(vl-cmdf "_.ROTATE" ss "" pc rd)
(prompt (strcat "\r" str "左旋"))
)
((or (equal gr '(2 69))(equal gr '(2 101))) ;Ee
(vl-cmdf "_.ROTATE" ss "" pc (- rd))
(prompt (strcat "\r" str "右旋"))
)
)
)
))
(setvar 'cmdecho 1)
(princ)
)
ZZXXQQ 发表于 2014-12-20 21:27 static/image/common/back.gif
感谢zzz版百忙中抽空写程序 zzz版 能不能不要R- F+啊直接输入数字这个数字要能记忆 还有zz版现在这个程序中左旋无效果 好吧 帮忙帮到底了
(defun c:tt (/ _getreal _getpoint gr ss str)
(defun _getreal (msg default / ret)
(setq ret (getreal (strcat msg " <" (rtos default) ">:")))
(if (null ret)
default
ret
)
)
(defun _getpoint (/ p)
(while (null (setq p (getpoint "指定旋转基点:"))))
p
)
(setvar 'cmdecho 0)
(if (null *grmovedis*)
(setq *grmovedis* 4.0)
)
(if (null *grangles*)
(setq *grangles* 90.0)
)
(setq str "\n按W S A D 移动, Q向左旋转, E向右旋转 R设置步长 T设置角度, 空格回车或左\右键退出:")
(princ (strcat "\n步长 = " (rtos *grmovedis* 2) ""))
(if (setq ss (ssget))
(progn (princ str)
(while (and (/= (car (setq gr (grread t 15 0))) 3)
(not (equal gr '(2 32)))
(not (equal gr '(2 13)))
(not (equal gr '(11 0)))
(not (equal gr '(25 0)))
)
(cond ((or (equal gr '(2 119)) (equal gr '(2 87))) ;wW
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) *grmovedis*))
)
((or (equal gr '(2 83)) (equal gr '(2 115))) ;Ss
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) *grmovedis*))
)
((or (equal gr '(2 65)) (equal gr '(2 97))) ;Aa
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi *grmovedis*))
)
((or (equal gr '(2 68)) (equal gr '(2 100))) ;Dd
(vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 *grmovedis*))
)
((or (equal gr '(2 69)) (equal gr '(2 101))) ;Ee
(vl-cmdf "_.rotate" ss "" (_getpoint) (- *grangles*))
)
((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq
(vl-cmdf "_.rotate" ss "" (_getpoint) *grangles*)
)
((or (equal gr '(2 82)) (equal gr '(2 114))) ;Rr
(setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))
(princ str)
)
((or (equal gr '(2 84)) (equal gr '(2 116))) ;Tt
(setq *grangles* (abs (_getreal "\n输入每次旋转的角度" *grangles*)))
(princ str)
)
)
)
)
)
(setvar 'cmdecho 1)
(princ)
)
页:
[1]
2