程序加个功能 ZZ版 vectra高手 过来瞧瞧 看看

love1030312

   论坛大神们帮忙写的一个程序  非常好用    最近工作需要   加个功能
加个Q向左旋转  E向右旋转   旋转角度默认为90度   如果能留个设置旋转的角度就更好
以前的Q设置  改为R

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

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

vectra

求形心函数改自Z版，特此声明
同时修改了移位后重新计算形心，以保持以选择集中心旋转。

1. (defun c:tt (/ _getreal _getpoint 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. 
   
10.   (defun _getpoint (ss / a b i m1 m2 p1 p2)
    
11.     (repeat (setq i (sslength ss))
    
12.       (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'p1 'p2)
    
13.       (setq p1 (vlax-safearray->list p1)
    
14.             p2 (vlax-safearray->list p2)
    
15.       )
    
16.       (if (null m1)
    
17.         (setq m1 p1)
    
18.         (setq m1 (mapcar 'min m1 p1))
    
19.       )
    
20.       (if (null m2)
    
21.         (setq m2 p2)
    
22.         (setq m2 (mapcar 'max m2 p2))
    
23.       )
    
24.     )
    
25.     (mapcar '(lambda (a b) (/ (+ a b) 2)) m1 m2)
    
26.   )
    
27. 
    
28.   (setvar 'cmdecho 0)
    
29.   (if (null *grmovedis*)
    
30.     (setq *grmovedis* 4.0)
    
31.   )
    
32.   (if (null *grangles*)
    
33.     (setq *grangles* 90.0)
    
34.   )
    
35.   (setq str "\n按W S A D 移动, Q向左旋转, E向右旋转 R设置步长 T设置角度, 空格回车或左\右键退出:")
    
36.   (princ (strcat "\n步长 = " (rtos *grmovedis* 2) ""))
    
37.   (if (setq ss (ssget))
    
38.     (progn (princ str)
    
39.            (while (and (/= (car (setq gr (grread t 15 0))) 3)
    
40.                        (not (equal gr '(2 32)))
    
41.                        (not (equal gr '(2 13)))
    
42.                        (not (equal gr '(11 0)))
    
43.                        (not (equal gr '(25 0)))
    
44.                   )
    
45.              (cond ((or (equal gr '(2 119)) (equal gr '(2 87))) ;wW
    
46.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) *grmovedis*))
    
47.                    )
    
48.                    ((or (equal gr '(2 83)) (equal gr '(2 115))) ;Ss
    
49.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) *grmovedis*))
    
50.                    )
    
51.                    ((or (equal gr '(2 65)) (equal gr '(2 97))) ;Aa
    
52.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi *grmovedis*))
    
53.                    )
    
54.                    ((or (equal gr '(2 68)) (equal gr '(2 100))) ;Dd
    
55.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 *grmovedis*))
    
56.                    )
    
57.                    ((or (equal gr '(2 69)) (equal gr '(2 101))) ;Ee
    
58.                     (vl-cmdf "_.rotate" ss "" (_getpoint ss) (- *grangles*))
    
59.                    )
    
60.                    ((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq
    
61.                     (vl-cmdf "_.rotate" ss "" (_getpoint ss) *grangles*)
    
62.                    )
    
63.                    ((or (equal gr '(2 82)) (equal gr '(2 114))) ;Rr
    
64.                     (setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))
    
65.                     (princ str)
    
66.                    )
    
67.                    ((or (equal gr '(2 84)) (equal gr '(2 116))) ;Tt
    
68.                     (setq *grangles* (abs (_getreal "\n输入每次旋转的角度" *grangles*)))
    
69.                     (princ str)
    
70.                    )
    
71.              )
    
72.            )
    
73.     )
    
74.   )
    
75.   (setvar 'cmdecho 1)
    
76.   (princ)
    
77. )

(defun c:tt (/ _getreal _getpoint 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 /> <br />   (defun _getpoint (ss / a b i m1 m2 p1 p2)<br />     (repeat (setq i (sslength ss))<br />       (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'p1 'p2)<br />       (setq p1 (vlax-safearray->list p1)<br />             p2 (vlax-safearray->list p2)<br />       )<br />       (if (null m1)<br />         (setq m1 p1)<br />         (setq m1 (mapcar 'min m1 p1))<br />       )<br />       (if (null m2)<br />         (setq m2 p2)<br />         (setq m2 (mapcar 'max m2 p2))<br />       )<br />     )<br />     (mapcar '(lambda (a b) (/ (+ a b) 2)) m1 m2)<br />   )<br /> <br />   (setvar 'cmdecho 0)<br />   (if (null *grmovedis*)<br />     (setq *grmovedis* 4.0)<br />   )<br />   (if (null *grangles*)<br />     (setq *grangles* 90.0)<br />   )<br />   (setq str "\n按W S A D 移动, Q向左旋转, E向右旋转 R设置步长 T设置角度, 空格回车或左\右键退出:")<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 69)) (equal gr '(2 101))) ;Ee<br />                     (vl-cmdf "_.rotate" ss "" (_getpoint ss) (- *grangles*))<br />                    )<br />                    ((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq<br />                     (vl-cmdf "_.rotate" ss "" (_getpoint ss) *grangles*)<br />                    )<br />                    ((or (equal gr '(2 82)) (equal gr '(2 114))) ;Rr<br />                     (setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))<br />                     (princ str)<br />                    )<br />                    ((or (equal gr '(2 84)) (equal gr '(2 116))) ;Tt<br />                     (setq *grangles* (abs (_getreal "\n输入每次旋转的角度" *grangles*)))<br />                     (princ str)<br />                    )<br />              )<br />            )<br />     )<br />   )<br />   (setvar 'cmdecho 1)<br />   (princ)<br /> )

lucas_3333

此码的原作者是谁？

love1030312

lucas_3333 发表于 2014-12-20 19:59
此码的原作者是谁？

zzz版   怎么了？

love1030312

lucas_3333 发表于 2014-12-20 19:59
此码的原作者是谁？

vectra  他帮忙修改过一次   啥问题 大哥

lucas_3333

love1030312 发表于 2014-12-20 20:01
vectra  他帮忙修改过一次   啥问题 大哥

如果是这样，何不在原贴下面跟贴呢？然后给Z版或vectra大侠一个消息，如果大家在论坛看到一个程序，这个想这样改，那个想那样改，都发新主题，那样不是不利于查找？

鱼与熊掌

             楼上说的有理有据.

ZZXXQQ

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

love1030312

ZZXXQQ 发表于 2014-12-20 21:27
[/post]

感谢zzz版百忙中抽空写程序    zzz版 能不能不要R- F+啊  直接输入数字  这个数字要能记忆   还有zz版现在这个程序中左旋无效果

vectra

好吧 帮忙帮到底了

1. (defun c:tt (/ _getreal _getpoint 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.   (defun _getpoint (/ p)
   
10.     (while (null (setq p (getpoint "指定旋转基点:"))))
    
11.     p
    
12.   )
    
13.   (setvar 'cmdecho 0)
    
14.   (if (null *grmovedis*)
    
15.     (setq *grmovedis* 4.0)
    
16.   )
    
17.   (if (null *grangles*)
    
18.     (setq *grangles* 90.0)
    
19.   )
    
20.   (setq str "\n按W S A D 移动, Q向左旋转, E向右旋转 R设置步长 T设置角度, 空格回车或左\右键退出:")
    
21.   (princ (strcat "\n步长 = " (rtos *grmovedis* 2) ""))
    
22.   (if (setq ss (ssget))
    
23.     (progn (princ str)
    
24.            (while (and (/= (car (setq gr (grread t 15 0))) 3)
    
25.                        (not (equal gr '(2 32)))
    
26.                        (not (equal gr '(2 13)))
    
27.                        (not (equal gr '(11 0)))
    
28.                        (not (equal gr '(25 0)))
    
29.                   )
    
30.              (cond ((or (equal gr '(2 119)) (equal gr '(2 87))) ;wW
    
31.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 0.5) *grmovedis*))
    
32.                    )
    
33.                    ((or (equal gr '(2 83)) (equal gr '(2 115))) ;Ss
    
34.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) (* pi 1.5) *grmovedis*))
    
35.                    )
    
36.                    ((or (equal gr '(2 65)) (equal gr '(2 97))) ;Aa
    
37.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) pi *grmovedis*))
    
38.                    )
    
39.                    ((or (equal gr '(2 68)) (equal gr '(2 100))) ;Dd
    
40.                     (vl-cmdf "_.move" ss "" '(0 0) (polar '(0 0) 0 *grmovedis*))
    
41.                    )
    
42.                    ((or (equal gr '(2 69)) (equal gr '(2 101))) ;Ee
    
43.                     (vl-cmdf "_.rotate" ss "" (_getpoint) (- *grangles*))
    
44.                    )
    
45.                    ((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq
    
46.                     (vl-cmdf "_.rotate" ss "" (_getpoint) *grangles*)
    
47.                    )
    
48.                    ((or (equal gr '(2 82)) (equal gr '(2 114))) ;Rr
    
49.                     (setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))
    
50.                     (princ str)
    
51.                    )
    
52.                    ((or (equal gr '(2 84)) (equal gr '(2 116))) ;Tt
    
53.                     (setq *grangles* (abs (_getreal "\n输入每次旋转的角度" *grangles*)))
    
54.                     (princ str)
    
55.                    )
    
56.              )
    
57.            )
    
58.     )
    
59.   )
    
60.   (setvar 'cmdecho 1)
    
61.   (princ)
    
62. )

(defun c:tt (/ _getreal _getpoint 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 />   (defun _getpoint (/ p)<br />     (while (null (setq p (getpoint "指定旋转基点:"))))<br />     p<br />   )<br />   (setvar 'cmdecho 0)<br />   (if (null *grmovedis*)<br />     (setq *grmovedis* 4.0)<br />   )<br />   (if (null *grangles*)<br />     (setq *grangles* 90.0)<br />   )<br />   (setq str "\n按W S A D 移动, Q向左旋转, E向右旋转 R设置步长 T设置角度, 空格回车或左\右键退出:")<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 69)) (equal gr '(2 101))) ;Ee<br />                     (vl-cmdf "_.rotate" ss "" (_getpoint) (- *grangles*))<br />                    )<br />                    ((or (equal gr '(2 81)) (equal gr '(2 113))) ;Qq<br />                     (vl-cmdf "_.rotate" ss "" (_getpoint) *grangles*)<br />                    )<br />                    ((or (equal gr '(2 82)) (equal gr '(2 114))) ;Rr<br />                     (setq *grmovedis* (_getreal "\n输入每次移动的步长" *grmovedis*))<br />                     (princ str)<br />                    )<br />                    ((or (equal gr '(2 84)) (equal gr '(2 116))) ;Tt<br />                     (setq *grangles* (abs (_getreal "\n输入每次旋转的角度" *grangles*)))<br />                     (princ str)<br />                    )<br />              )<br />            )<br />     )<br />   )<br />   (setvar 'cmdecho 1)<br />   (princ)<br /> )