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

love1030312

  这是以前ZZ版帮忙写的一个程序  一直以来都是很好用的
请ZZ版帮忙修改下
不要Q- E+ 了 改成直接输入数字  这个数字要有记忆功能  （我所说的记忆就是在不退出当前CAD ，再用这个程序还是上次输入的那个数字）

2. (defun c:tt(/ GR SS ds str)  
   
3.   (setvar 'cmdecho 0)
   
4.   (setq ds 4.0)
   
5.   (setq str "按W S A D 移动Q-,E+,空格回车左\右键退出:")
   
6.   (if (setq ss(ssget)) (progn
   
7.    (princ (strcat "\n" str "距离" (rtos ds 2)))
   
8.    (while (and (/= (car (setq gr(grread t 15 0)))3)
   
9.                (not(equal gr '(2 32)))
   
10.                (not(equal gr '(2 13)))
    
11.                (not(equal gr '(11 0)))
    
12.                (not(equal gr '(25 0))))   
    
13.     (cond
    
14.      ((or (equal gr '(2 119))(equal gr '(2 87)))       ;wW
    
15.       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) ds))
    
16.       (prompt (strcat "\r" str "向上移动"))
    
17.      )
    
18.      ((or (equal gr '(2 83))(equal gr '(2 115)))       ;Ss
    
19.       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) ds))
    
20.       (prompt (strcat "\r" str "向下移动"))
    
21.      )
    
22.      ((or (equal gr '(2 65))(equal gr '(2 97)))        ;Aa
    
23.       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi ds))
    
24.       (prompt (strcat "\r" str "向左移动"))
    
25.      )
    
26.      ((or (equal gr '(2 68))(equal gr '(2 100)))       ;Dd
    
27.       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 ds))
    
28.       (prompt (strcat "\r" str "向右移动"))
    
29.      )      
    
30.      ((or (equal gr '(2 81))(equal gr '(2 113)))       ;Qq
    
31.       (setq ds (- ds 4) ds (if (< ds 0) 0 ds))
    
32.       (prompt (strcat "\r" str "距离" (rtos ds 2)))
    
33.      )      
    
34.      ((or (equal gr '(2 69))(equal gr '(2 101)))       ;Ee
    
35.       (setq ds (+ ds 4))
    
36.       (prompt (strcat "\r" str "距离" (rtos ds 2)))
    
37.      )      
    
38.     )
    
39.    )
    
40.   ))
    
41.   (setvar 'cmdecho 1)
    
42.   (princ)
    
43. )

(defun c:tt(/ GR SS ds str)  <br />   (setvar 'cmdecho 0)<br />   (setq ds 4.0)<br />   (setq str "按W S A D 移动Q-,E+,空格回车左\右键退出:")<br />   (if (setq ss(ssget)) (progn<br />    (princ (strcat "\n" str "距离" (rtos ds 2)))<br />    (while (and (/= (car (setq gr(grread t 15 0)))3)<br />                (not(equal gr '(2 32)))<br />                (not(equal gr '(2 13)))<br />                (not(equal gr '(11 0)))<br />                (not(equal gr '(25 0))))    <br />     (cond<br />      ((or (equal gr '(2 119))(equal gr '(2 87)))       ;wW<br />       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) ds))<br />       (prompt (strcat "\r" str "向上移动"))<br />      )<br />      ((or (equal gr '(2 83))(equal gr '(2 115)))       ;Ss<br />       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) ds))<br />       (prompt (strcat "\r" str "向下移动"))<br />      )<br />      ((or (equal gr '(2 65))(equal gr '(2 97)))        ;Aa<br />       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi ds))<br />       (prompt (strcat "\r" str "向左移动"))<br />      )<br />      ((or (equal gr '(2 68))(equal gr '(2 100)))       ;Dd<br />       (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 ds))<br />       (prompt (strcat "\r" str "向右移动"))<br />      )      <br />      ((or (equal gr '(2 81))(equal gr '(2 113)))       ;Qq<br />       (setq ds (- ds 4) ds (if (< ds 0) 0 ds))<br />       (prompt (strcat "\r" str "距离" (rtos ds 2)))<br />      )      <br />      ((or (equal gr '(2 69))(equal gr '(2 101)))       ;Ee<br />       (setq ds (+ ds 4))<br />       (prompt (strcat "\r" str "距离" (rtos ds 2)))<br />      )      <br />     )<br />    )<br />   ))<br />   (setvar 'cmdecho 1)<br />   (princ)<br /> )

vectra

1. (defun c:tt (/ _getreal gr ss str)
   
2.   (defun _getreal (msg default / ret)
   
3.     (setq ret (getreal (strcat msg " <" (rtos default) ">:")))
   
4.     (if        (null ret)
   
5.       default
   
6.       ret
   
7.     )
   
8.   )
   
9.   (setvar 'cmdecho 0)
   
10.   (if (null *grmovedis*)
    
11.     (setq *grmovedis* 4.0)
    
12.   )
    
13.   (setq str "\n按W S A D 移动, Q 设置步长, 空格回车或左\右键退出:")
    
14.   (princ (strcat "\n步长 = " (rtos *grmovedis* 2) ""))
    
15.   (if (setq ss (ssget))
    
16.     (progn (princ str)
    
17.            (while (and (/= (car (setq gr (grread t 15 0))) 3)
    
18.                        (not (equal gr '(2 32)))
    
19.                        (not (equal gr '(2 13)))
    
20.                        (not (equal gr '(11 0)))
    
21.                        (not (equal gr '(25 0)))
    
22.                   )
    
23.              (cond ((or (equal gr '(2 119)) (equal gr '(2 87))) ;wW
    
24.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) *grmovedis*))
    
25.                    )
    
26.                    ((or (equal gr '(2 83)) (equal gr '(2 115))) ;Ss
    
27.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) *grmovedis*))
    
28.                    )
    
29.                    ((or (equal gr '(2 65)) (equal gr '(2 97))) ;Aa
    
30.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi *grmovedis*))
    
31.                    )
    
32.                    ((or (equal gr '(2 68)) (equal gr '(2 100))) ;Dd
    
33.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 *grmovedis*))
    
34.                    )
    
35.                    ((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq
    
36.                     (setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))
    
37.                     (princ str)
    
38.                    )
    
39.              )
    
40.            )
    
41.     )
    
42.   )
    
43.   (setvar 'cmdecho 1)
    
44.   (princ)
    
45. )

(defun c:tt (/ _getreal gr ss str)<br />   (defun _getreal (msg default / ret)<br />     (setq ret (getreal (strcat msg " <" (rtos default) ">:")))<br />     (if        (null ret)<br />       default<br />       ret<br />     )<br />   )<br />   (setvar 'cmdecho 0)<br />   (if (null *grmovedis*)<br />     (setq *grmovedis* 4.0)<br />   )<br />   (setq str "\n按W S A D 移动, Q 设置步长, 空格回车或左\右键退出:")<br />   (princ (strcat "\n步长 = " (rtos *grmovedis* 2) ""))<br />   (if (setq ss (ssget))<br />     (progn (princ str)<br />            (while (and (/= (car (setq gr (grread t 15 0))) 3)<br />                        (not (equal gr '(2 32)))<br />                        (not (equal gr '(2 13)))<br />                        (not (equal gr '(11 0)))<br />                        (not (equal gr '(25 0)))<br />                   )<br />              (cond ((or (equal gr '(2 119)) (equal gr '(2 87))) ;wW<br />                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) *grmovedis*))<br />                    )<br />                    ((or (equal gr '(2 83)) (equal gr '(2 115))) ;Ss<br />                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) *grmovedis*))<br />                    )<br />                    ((or (equal gr '(2 65)) (equal gr '(2 97))) ;Aa<br />                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi *grmovedis*))<br />                    )<br />                    ((or (equal gr '(2 68)) (equal gr '(2 100))) ;Dd<br />                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 *grmovedis*))<br />                    )<br />                    ((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq<br />                     (setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))<br />                     (princ str)<br />                    )<br />              )<br />            )<br />     )<br />   )<br />   (setvar 'cmdecho 1)<br />   (princ)<br /> )

ZZXXQQ

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

love1030312

ZZXXQQ 发表于 2014-11-16 08:40
将
  (setq ds 4.0)
改成

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

langjs

写入注册表或者文本记忆

love1030312

vectra 发表于 2014-11-16 10:22

谢谢大神

296715530

真服

999999

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

zmzk

不错，好方法