【一个关于旋转的程序求小改】

fire9527

有如下程序，功能是选择对象后，能通过键盘按钮在一定步长值下连续动态旋转，现在希望增加如下一个设置：
1.选择需要旋转的对象
2.选择弧线，以弧线的圆心为基点旋转刚选择的对象（第2步时，默认上一次选择的旋转基点，如果没有上一次，则提示选择弧线）
程序的提示顺序是这样的：选择要旋转的对象-----选择弧线获取圆心作为旋转基点（右键默认上一次基点）-----通过键盘按键旋转目标


下面已有的程序中，只需要将第2步加入即可，期待高手帮忙！
;;; -------------------------------------------------------------------------------------------------------------------

;;;      通过键盘旋转目标
;;;     By  weiqi ，孤帆修改  http://bbs.mjtd.com/forum.php?mo ... &fromuid=423168
;;; -------------------------------------------------------------------------------------------------------------------

(DEFUN C:kr (/ cmd loop SSet KeyList n step BasePoint0 BasePoint1 BasePoint2)
(SETQ cmd (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(SETQ loop 1)
(WHILE loop
  (PROMPT "\n 选择对象 : ")
  (SETQ SSet (SSGET))
  (COND
   ((NULL SSet)(ALERT "没有选中对象!"))
   (T (SETQ loop nil))
  )
)
(setq p1 (getpoint "指定基点: "))

(PRINC "\n Press key:")
(PRINC "\n\t 《Q键 0.1度》《W键 -0.1度》   ")
(PRINC "\n\t 《A键 1度》《S键 -1度》   ")

(TERPRI)
(SETQ KeyList '(32  49 50 65 68 81 83 87 119 101 113 32 115 97 100))
(WHILE (and(/= (SETQ n (CADR (GRREAD))) 13)
  (MEMBER n KeyList))
   (COND

    ((= n 113)(COMMAND "ROTATE" SSet "" p1 0.1)(PRINC "\r< q 0.1度 >"))
    ((= n 81)(COMMAND "ROTATE" SSet "" p1 0.1)(PRINC "\r< Q 0.1度 >"))
    ((= n 119)(COMMAND "ROTATE" SSet "" p1 -0.1)(PRINC "\r< w -0.1度 >"))
    ((= n 87)(COMMAND "ROTATE" SSet "" p1 -0.1)(PRINC "\r< W -0.1度 >"))
    ((= n 97) (COMMAND "ROTATE" SSet "" p1 1)(PRINC "\r< a  1度>"))
    ((= n 65) (COMMAND "ROTATE" SSet "" p1 1)(PRINC "\r< A  1度>"))
    ((= n 115)(COMMAND "ROTATE" SSet "" p1 -1)(PRINC "\r< s -1度>"))
    ((= n 83)(COMMAND "ROTATE" SSet "" p1 -1)(PRINC "\r< S -1度>"))
    ((= n 32))
  )
);WHILE
(SETVAR "CMDECHO" cmd)
(PRINC)
)

vectra

fire9527 发表于 2015-8-22 08:18
长老，程序还有点小问题哦，有时间还请再看一下

修改了一下Z版的程序，感觉舒服了。。。

1. (if (null *last-rotate-point*)
   
2.   (setq *last-rotate-point* '(0 0 0))
   
3. )
   
4. 
   
5. (defun pick-rotate-point (/ p ent)
   
6.   (initget "A")
   
7.   (setq
   
8.     p (getpoint
   
9.         (strcat "\n指定旋转基点或 [选择弧心(A)] <" (vl-princ-to-string *last-rotate-point*) ">:")
   
10.       )
    
11.   )
    
12. 
    
13.   (cond        ((= p "A")
    
14.          (while        (not (listp p))
    
15.            (if (and (setq ent (entsel "\n选择圆或圆弧:"))
    
16.                     (setq ent (entget (car ent)))
    
17.                     (wcmatch (cdr (assoc 0 ent)) "ARC,CIRCLE")
    
18.                )
    
19.              (setq p (cdr (assoc 10 ent)))
    
20.            )
    
21.          )
    
22.         )
    
23.         ((null p)
    
24.          (setq p *last-rotate-point*)
    
25.         )
    
26.   )
    
27.   (setq *last-rotate-point* p)
    
28. )
    
29. 
    
30. 
    
31. 
    
32. (defun c:kr (/ cmd gr n p1 sset)
    
33.   (setq cmd (getvar "CMDECHO"))
    
34.   (setvar "CMDECHO" 0)
    
35. 
    
36.   (if (setq sset (ssget))
    
37.     (progn
    
38.       (setq p1 (pick-rotate-point))
    
39. 
    
40.       (princ "\n按 Q/W +/-0.1度, A/S +/-1度, 空格回车或左\右键退出:")
    
41. 
    
42.       (while (and (/= (car (setq gr (grread nil 15))) 3)
    
43.                   (not (equal gr '(2 32)))
    
44.                   (not (equal gr '(2 13)))
    
45.                   (not (equal (car gr) 11))
    
46.                   (not (equal (car gr) 25))
    
47.              )
    
48.         (setq n (cadr gr))
    
49.         (cond
    
50.           ((or (= n 81) (= n 113)) ;_ Qq
    
51.            (command "ROTATE" sset "" p1 0.1)
    
52.           )
    
53.           ((or (= n 87) (= n 119)) ;_ Rr
    
54.            (command "ROTATE" sset "" p1 -0.1)
    
55.           )
    
56.           ((or (= n 65) (= n 97)) ;_ Aa
    
57.            (command "ROTATE" sset "" p1 1)
    
58.           )
    
59.           ((or (= n 83) (= n 115)) ;_Ss
    
60.            (command "ROTATE" sset "" p1 -1)
    
61.           )
    
62.         )
    
63.       )
    
64.     )
    
65.   )
    
66. 
    
67.   (setvar "CMDECHO" cmd)
    
68.   (princ)
    
69. )
    

(if (null *last-rotate-point*)<br />   (setq *last-rotate-point* '(0 0 0))<br /> )<br /> <br /> (defun pick-rotate-point (/ p ent)<br />   (initget "A")<br />   (setq<br />     p (getpoint<br />         (strcat "\n指定旋转基点或 [选择弧心(A)] <" (vl-princ-to-string *last-rotate-point*) ">:")<br />       )<br />   )<br /> <br />   (cond        ((= p "A")<br />          (while        (not (listp p))<br />            (if (and (setq ent (entsel "\n选择圆或圆弧:"))<br />                     (setq ent (entget (car ent)))<br />                     (wcmatch (cdr (assoc 0 ent)) "ARC,CIRCLE")<br />                )<br />              (setq p (cdr (assoc 10 ent)))<br />            )<br />          )<br />         )<br />         ((null p)<br />          (setq p *last-rotate-point*)<br />         )<br />   )<br />   (setq *last-rotate-point* p)<br /> )<br /> <br /> <br /> <br /> (defun c:kr (/ cmd gr n p1 sset)<br />   (setq cmd (getvar "CMDECHO"))<br />   (setvar "CMDECHO" 0)<br /> <br />   (if (setq sset (ssget))<br />     (progn<br />       (setq p1 (pick-rotate-point))<br /> <br />       (princ "\n按 Q/W +/-0.1度, A/S +/-1度, 空格回车或左\右键退出:")<br /> <br />       (while (and (/= (car (setq gr (grread nil 15))) 3)<br />                   (not (equal gr '(2 32)))<br />                   (not (equal gr '(2 13)))<br />                   (not (equal (car gr) 11))<br />                   (not (equal (car gr) 25))<br />              )<br />         (setq n (cadr gr))<br />         (cond<br />           ((or (= n 81) (= n 113)) ;_ Qq<br />            (command "ROTATE" sset "" p1 0.1)<br />           )<br />           ((or (= n 87) (= n 119)) ;_ Rr<br />            (command "ROTATE" sset "" p1 -0.1)<br />           )<br />           ((or (= n 65) (= n 97)) ;_ Aa<br />            (command "ROTATE" sset "" p1 1)<br />           )<br />           ((or (= n 83) (= n 115)) ;_Ss<br />            (command "ROTATE" sset "" p1 -1)<br />           )<br />         )<br />       )<br />     )<br />   )<br /> <br />   (setvar "CMDECHO" cmd)<br />   (princ)<br /> )<br />

Andyhon

(SETQ SSet (SSGET))
  ...
(setq p1 (getpoint "指定基点: "))

第二次选择与上一次选择的弧线不同但 旋转基点 为同一共点弧心之意嗎?

ZZXXQQ

2. ;;;通过键盘旋转目标
   
3. ;;;By  weiqi，孤帆修改  <A href="<A href='http://bbs.mjtd.com/forum.php?mo">http://bbs.mjtd.com/forum.php?mo</A'>http://bbs.mjtd.com/forum.php?mo">http://bbs.mjtd.com/forum.php?mo</A</A>> ... &fromuid=423168
   
4. ;弧心旋转 2015.8.22 ZZXXQQ 改
   
5. (defun C:kr (/ cmd loop SSet KeyList n p1)
   
6. (setq cmd (getvar "CMDECHO"))
   
7. (setvar "CMDECHO" 0)
   
8. (setq loop T)
   
9. (while loop
   
10.   (prompt "\n 选择对象 : ")
    
11.   (if (setq SSet (ssget))
    
12.    (setq loop nil)
    
13.    (alert "没有选中对象!")
    
14.   )
    
15. )
    
16. ;(setq p1 (getpoint "指定基点: "))
    
17. (if (and (setq s1 (entsel "\n选择圆弧（中心为旋转基点）: "))
    
18.          (setq ent (entget(car s1)))
    
19.          (wcmatch (cdr(assoc 0 ent)) "ARC,CIRCLE"))
    
20. (setq p1 (cdr(assoc 10 ent)))
    
21. (if (not(listp p1)) (setq p1 '(0 0)))
    
22. )
    
23. (princ "\n Press key:\n\t 《Q键 0.1度》《W键 -0.1度》\n\t 《A键 1度》《S键 -1度》")
    
24. (terpri)
    
25. ;(setq KeyList '(32  49 50 65 68 81 83 87 119 101 113 32 115 97 100))
    
26. (setq KeyList '(32 65 81 83 87 97 113 115 119))
    
27. (while (and(/= (setq n (cadr (grread))) 13)
    
28.   (member n KeyList))
    
29.    (cond
    
30.     ((= n 113)(command "ROTATE" SSet "" p1 0.1)(princ "\r< q 0.1度 >"))
    
31.     ((= n 81)(command "ROTATE" SSet "" p1 0.1)(princ "\r< Q 0.1度 >"))
    
32.     ((= n 119)(command "ROTATE" SSet "" p1 -0.1)(princ "\r< w -0.1度 >"))
    
33.     ((= n 87)(command "ROTATE" SSet "" p1 -0.1)(princ "\r< W -0.1度 >"))
    
34.     ((= n 97) (command "ROTATE" SSet "" p1 1)(princ "\r< a  1度>"))
    
35.     ((= n 65) (command "ROTATE" SSet "" p1 1)(princ "\r< A  1度>"))
    
36.     ((= n 115)(command "ROTATE" SSet "" p1 -1)(princ "\r< s -1度>"))
    
37.     ((= n 83)(command "ROTATE" SSet "" p1 -1)(princ "\r< S -1度>"))
    
38.     ((= n 32))
    
39.   )
    
40. );while
    
41. (setvar "CMDECHO" cmd)
    
42. (princ)
    
43. )
    

;;;通过键盘旋转目标<br /> ;;;By  weiqi，孤帆修改  <A href="<A href='http://bbs.mjtd.com/forum.php?mo">http://bbs.mjtd.com/forum.php?mo</A'>http://bbs.mjtd.com/forum.php?mo">http://bbs.mjtd.com/forum.php?mo</A</A>> ... &fromuid=423168<br /> ;弧心旋转 2015.8.22 ZZXXQQ 改<br /> (defun C:kr (/ cmd loop SSet KeyList n p1)<br /> (setq cmd (getvar "CMDECHO"))<br /> (setvar "CMDECHO" 0)<br /> (setq loop T)<br /> (while loop<br />   (prompt "\n 选择对象 : ")<br />   (if (setq SSet (ssget))<br />    (setq loop nil)<br />    (alert "没有选中对象!")<br />   )<br /> )<br /> ;(setq p1 (getpoint "指定基点: "))<br /> (if (and (setq s1 (entsel "\n选择圆弧（中心为旋转基点）: "))<br />          (setq ent (entget(car s1)))<br />          (wcmatch (cdr(assoc 0 ent)) "ARC,CIRCLE"))<br /> (setq p1 (cdr(assoc 10 ent)))<br /> (if (not(listp p1)) (setq p1 '(0 0)))<br /> )<br /> (princ "\n Press key:\n\t 《Q键 0.1度》《W键 -0.1度》\n\t 《A键 1度》《S键 -1度》")<br /> (terpri)<br /> ;(setq KeyList '(32  49 50 65 68 81 83 87 119 101 113 32 115 97 100))<br /> (setq KeyList '(32 65 81 83 87 97 113 115 119))<br /> (while (and(/= (setq n (cadr (grread))) 13)<br />   (member n KeyList))<br />    (cond<br />     ((= n 113)(command "ROTATE" SSet "" p1 0.1)(princ "\r< q 0.1度 >"))<br />     ((= n 81)(command "ROTATE" SSet "" p1 0.1)(princ "\r< Q 0.1度 >"))<br />     ((= n 119)(command "ROTATE" SSet "" p1 -0.1)(princ "\r< w -0.1度 >"))<br />     ((= n 87)(command "ROTATE" SSet "" p1 -0.1)(princ "\r< W -0.1度 >"))<br />     ((= n 97) (command "ROTATE" SSet "" p1 1)(princ "\r< a  1度>"))<br />     ((= n 65) (command "ROTATE" SSet "" p1 1)(princ "\r< A  1度>"))<br />     ((= n 115)(command "ROTATE" SSet "" p1 -1)(princ "\r< s -1度>"))<br />     ((= n 83)(command "ROTATE" SSet "" p1 -1)(princ "\r< S -1度>"))<br />     ((= n 32))<br />   )<br /> );while<br /> (setvar "CMDECHO" cmd)<br /> (princ)<br /> )<br />

fire9527

Andyhon 发表于 2015-8-21 08:53
(SETQ SSet (SSGET))
  ...
(setq p1 (getpoint "指定基点: "))

对，弧线不同，但是弧心是同一点也是上一点

fire9527

ZZXXQQ 发表于 2015-8-21 09:18

Z版，程序运行到旋转那一步时，没什么反应呢，另外，貌似没有“右键默认上一次基点”的作用

Andyhon

既是 以弧线的圆心为基点旋转

那为何还要有 这句
(setq p1 (getpoint "指定基点: "))

feng83

不会做右键 [em0][em0][em0]
改了个不用左键，键盘操作的，不知道是不是楼主想要的
(DEFUN C:kr (/ cmd loop SSet KeyList n step BasePoint0 BasePoint1 BasePoint2)
(SETQ cmd (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(SETQ loop 1)
(WHILE loop
  (PROMPT "\n 选择对象 : ")
  (SETQ SSet (SSGET))
  (COND
   ((NULL SSet)(ALERT "没有选中对象!"))
   (T (SETQ loop nil))
  )
)
;(setq p1 (getpoint "指定基点: "))
(if p1
  (progn
    (setq w (getstring "\n是否以上次的旋转点为基点(确认请直接回车，重新选取点请按任意键) : "))
    (if (= w "") (setq p1 p1)
      (progn
        (setq en (entsel "\n选择圆弧（中心为旋转基点）: "))
        (setq el (entget(car en)))
        (setq en_typ (cdr (assoc 0 el)))
        (if (or (= en_typ "ARC")(= en_typ "CIRCLE"))
          (setq p1 (cdr (assoc 10 el)))
          (progn
            (setq loop t)
            (while loop
              (setq en (entsel "\n选择圆弧（中心为旋转基点）: "))
              (setq en_typ (cdr (assoc 0 (entget(car en)))))
              (if (or (= en_typ "ARC")(= en_typ "CIRCLE"))
                (setq loop nil)
                (setq loop t))
              )))))))
          

(PRINC "\n Press key:")
(PRINC "\n\t 《Q键 0.1度》《W键 -0.1度》   ")
(PRINC "\n\t 《A键 1度》《S键 -1度》   ")

(TERPRI)
(SETQ KeyList '(32  49 50 65 68 81 83 87 119 101 113 32 115 97 100))
(WHILE (and(/= (SETQ n (CADR (GRREAD))) 13)
  (MEMBER n KeyList))
   (COND

    ((= n 113)(COMMAND "ROTATE" SSet "" p1 0.1)(PRINC "\r< q 0.1度 >"))
    ((= n 81)(COMMAND "ROTATE" SSet "" p1 0.1)(PRINC "\r< Q 0.1度 >"))
    ((= n 119)(COMMAND "ROTATE" SSet "" p1 -0.1)(PRINC "\r< w -0.1度 >"))
    ((= n 87)(COMMAND "ROTATE" SSet "" p1 -0.1)(PRINC "\r< W -0.1度 >"))
    ((= n 97) (COMMAND "ROTATE" SSet "" p1 1)(PRINC "\r< a  1度>"))
    ((= n 65) (COMMAND "ROTATE" SSet "" p1 1)(PRINC "\r< A  1度>"))
    ((= n 115)(COMMAND "ROTATE" SSet "" p1 -1)(PRINC "\r< s -1度>"))
    ((= n 83)(COMMAND "ROTATE" SSet "" p1 -1)(PRINC "\r< S -1度>"))
    ((= n 32))
  )
);WHILE
(SETVAR "CMDECHO" cmd)
(PRINC)
)

fire9527

feng83 发表于 2015-8-21 19:28
不会做右键
改了个不用左键，键盘操作的，不知道是不是楼主想要的
(DEFUN C:kr (/ cmd l ...

朋友，选择完需要旋转的图元之后怎么就没反映了？

fire9527

ZZXXQQ 发表于 2015-8-21 09:18

长老，程序还有点小问题哦，有时间还请再看一下