love1030312 发表于 2014-11-16 00:05:19

优化程序 亲爱的ZZZ版 看过来

这是以前ZZ版帮忙写的一个程序一直以来都是很好用的
请ZZ版帮忙修改下
不要Q- E+ 了 改成直接输入数字这个数字要有记忆功能（我所说的记忆就是在不退出当前CAD ，再用这个程序还是上次输入的那个数字）(defun c:tt(/ GR SS ds str)
(setvar 'cmdecho 0)
(setq ds 4.0)
(setq str "按W S A D 移动Q-,E+,空格回车左\右键退出:")
(if (setq ss(ssget)) (progn
   (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)))       ;wW
      (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)))       ;Ss
      (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)))      ;Aa
      (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi ds))
      (prompt (strcat "\r" str "向左移动"))
   )
   ((or (equal gr '(2 68))(equal gr '(2 100)))       ;Dd
      (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
      (setq ds (- ds 4) ds (if (< ds 0) 0 ds))
      (prompt (strcat "\r" str "距离" (rtos ds 2)))
   )      
   ((or (equal gr '(2 69))(equal gr '(2 101)))       ;Ee
      (setq ds (+ ds 4))
      (prompt (strcat "\r" str "距离" (rtos ds 2)))
   )      
    )
   )
))
(setvar 'cmdecho 1)
(princ)
)

vectra 发表于 2014-11-16 00:05:20

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

ZZXXQQ 发表于 2014-11-16 08:40:32

将
(setq ds 4.0)
改成
(setq ds (if (numberp ds) ds 4.0))
即可

love1030312 发表于 2014-11-16 08:57:16

ZZXXQQ 发表于 2014-11-16 08:40 static/image/common/back.gif
将
(setq ds 4.0)
改成


zz版按照你说的改了 没效果啊 还是跟以前一样麻烦Z版改下

langjs 发表于 2014-11-16 09:37:58

写入注册表或者文本记忆

love1030312 发表于 2014-11-16 10:41:22

vectra 发表于 2014-11-16 10:22 static/image/common/back.gif


谢谢大神

296715530 发表于 2019-12-12 14:27:07

真服

999999 发表于 2020-9-11 21:32:43

顶一下，谢谢楼主及评论区的大神，请问这个是什么作用呀

zmzk 发表于 2022-1-29 17:19:21

不错，好方法
页: [1]
查看完整版本: 优化程序 亲爱的ZZZ版 看过来