[LISP程序]：旋转UCS,类似ExpressTools的rtucs

e2002

2. 
   
3. ;; 旋转UCS ,类似ExpressTools中的 rtucs, 因为要让R14用户使用,故只使用了command.
   
4. ;; 临时写的,没有仔细测试,如发现问题请 email : [email]lkcadway@21cn.com[/email]
   
5. 
   
6. ;; add "F " option  : exit and planview
   
7. ;; 2003/06/20
   
8. 
   
9. 
   
10. ;; 系统要求: AutoCAD R14~2004
    
11. ;; 专业    : 任意 , 对经常使用UCS的人更有用些.
    
12. ;; written by e2002    2003/06/19
    
13. 
    
14. (defun C:lkpt:UCS:Rotate ( /
    
15.                            lkpt:UCS:Rotate:err
    
16.                           
    
17.                            oldvar1 oldvar2 oldvar3 olderr
    
18.                            bLoop bDirection sAxis rAngle
    
19.                            sDirection sKey sAngle rAngle-in
    
20.                          )
    
21. 
    
22.   (defun lkpt:UCS:Rotate:err (sErrMsg)
    
23.     (if        (/= sErrMsg "Function cancelled")
    
24.       (princ (strcat "\nerror : " sErrMsg))
    
25.     )
    
26.     (command "_.ucs" "_d" "$_lkpt_UCS_Rotate_Save")
    
27.     (setvar "CMDECHO" oldvar1)
    
28.     (setvar "DIMZIN" oldvar2)
    
29.     (setvar "UCSICON" oldvar3)
    
30.     (setq *error* olderr)
    
31.     (princ)
    
32.   )
    
33.    
    
34.   (setq oldvar1 (getvar "CMDECHO")
    
35.         oldvar2 (getvar "DIMZIN")
    
36.         oldvar3 (getvar "UCSICON")
    
37.         olderr  *error*
    
38.         *error* lkpt:UCS:Rotate:err
    
39.         bLoop T
    
40.         bDirection T
    
41.         sDirection "逆时针"
    
42.         sAxis "Z"
    
43.         rAngle 15.0
    
44.   )
    
45.   (setvar "CMDECHO" 0)
    
46.   (setvar "DIMZIN" 0)
    
47.   (if (/= oldvar3 3) (setvar "UCSICON" 3))
    
48.   (command "_.ucs" "_s" "$_lkpt_UCS_Rotate_Save")
    
49.   (while bLoop
    
50.     (princ "\n当前设定: 转动角度 : ") (princ rAngle)
    
51.     (princ "   转动方向 : ") (princ sDirection)
    
52.     (princ "    旋转轴  : ") (princ sAxis)
    
53.     (if bDirection
    
54.       (setq sDirection "顺时针")
    
55.       (setq sDirection "逆时针")
    
56.     )
    
57.     (initget "E W R A S D F")
    
58.     (setq sKey (getkword (strcat "\n按"Enter"开始转动UCS或设置[退出(Exit)/to Wcs/Restore/转角(A)/换转动轴(S)/" sDirection "(D))/exit and plan view(F)]  :")))
    
59.     (cond
    
60.       ( (null sKey) (command "_.ucs" "_n" sAxis rAngle) )
    
61.       ( (= sKey "E") (setq bLoop nil) )
    
62.       ( (= sKey "S")
    
63.         (cond
    
64.           ( (= sAxis "Z") (setq sAxis "X") )
    
65.           ( (= sAxis "X") (setq sAxis "Y") )
    
66.           ( (= sAxis "Y") (setq sAxis "Z") )
    
67.         )
    
68.       )
    
69.       ( (= sKey "W") (command "_.ucs" "_w") )
    
70.      ( (= sKey "F") (setq bLoop nil) (command "_.plan" "_c") )
    
71.       ( (= sKey "R")
    
72.         (command "_.ucs" "_r" "$_lkpt_UCS_Rotate_Save")
    
73.       )
    
74.       ( (= sKey "A")
    
75.         (setq sAngle (rtos rAngle 2 4)
    
76.               rAngle-in (getangle (strcat "\n指定转角[5/10/15/20/30/60/90/180] <" sAngle ">: "))
    
77.         )
    
78.         (if rAngle-in
    
79.           (setq rAngle (abs (/ (* rAngle-in 180.0) PI)))
    
80.         )
    
81.         (if (> rAngle 180.0)
    
82.           (setq rAngle (- rAngle 180.0))
    
83.         )
    
84.       )
    
85.       ( (= sKey "D")
    
86.         (setq bDirection (not bDirection)
    
87.               rAngle (- 0 rAngle)
    
88.         )
    
89.       )
    
90.     );end cond
    
91.   );end while
    
92.   (command "_.ucs" "_d" "$_lkpt_UCS_Rotate_Save")
    
93.   (setvar "CMDECHO" oldvar1)
    
94.   (setvar "DIMZIN" oldvar2)
    
95.   (setvar "UCSICON" oldvar3)
    
96.   (setq *error* olderr)
    
97.   (princ)
    
98. );end defun C:lkpt:UCS:Rotate
    

<br /> ;; 旋转UCS ,类似ExpressTools中的 rtucs, 因为要让R14用户使用,故只使用了command.<br /> ;; 临时写的,没有仔细测试,如发现问题请 email : [email]lkcadway@21cn.com[/email]<br /> <br /> ;; add "F " option  : exit and planview<br /> ;; 2003/06/20<br /> <br /> <br /> ;; 系统要求: AutoCAD R14~2004<br /> ;; 专业    : 任意 , 对经常使用UCS的人更有用些.<br /> ;; written by e2002    2003/06/19<br /> <br /> (defun C:lkpt:UCS:Rotate ( /<br />                            lkpt:UCS:Rotate:err<br />                           <br />                            oldvar1 oldvar2 oldvar3 olderr<br />                            bLoop bDirection sAxis rAngle<br />                            sDirection sKey sAngle rAngle-in<br />                          )<br /> <br />   (defun lkpt:UCS:Rotate:err (sErrMsg)<br />     (if        (/= sErrMsg "Function cancelled")<br />       (princ (strcat "\nerror : " sErrMsg))<br />     )<br />     (command "_.ucs" "_d" "$_lkpt_UCS_Rotate_Save")<br />     (setvar "CMDECHO" oldvar1)<br />     (setvar "DIMZIN" oldvar2)<br />     (setvar "UCSICON" oldvar3)<br />     (setq *error* olderr)<br />     (princ)<br />   )<br />     <br />   (setq oldvar1 (getvar "CMDECHO")<br />         oldvar2 (getvar "DIMZIN")<br />         oldvar3 (getvar "UCSICON")<br />         olderr  *error*<br />         *error* lkpt:UCS:Rotate:err<br />         bLoop T<br />         bDirection T<br />         sDirection "逆时针"<br />         sAxis "Z"<br />         rAngle 15.0<br />   )<br />   (setvar "CMDECHO" 0)<br />   (setvar "DIMZIN" 0)<br />   (if (/= oldvar3 3) (setvar "UCSICON" 3))<br />   (command "_.ucs" "_s" "$_lkpt_UCS_Rotate_Save")<br />   (while bLoop<br />     (princ "\n当前设定: 转动角度 : ") (princ rAngle)<br />     (princ "   转动方向 : ") (princ sDirection)<br />     (princ "    旋转轴  : ") (princ sAxis)<br />     (if bDirection<br />       (setq sDirection "顺时针")<br />       (setq sDirection "逆时针")<br />     )<br />     (initget "E W R A S D F")<br />     (setq sKey (getkword (strcat "\n按"Enter"开始转动UCS或设置[退出(Exit)/to Wcs/Restore/转角(A)/换转动轴(S)/" sDirection "(D))/exit and plan view(F)]  :")))<br />     (cond<br />       ( (null sKey) (command "_.ucs" "_n" sAxis rAngle) )<br />       ( (= sKey "E") (setq bLoop nil) )<br />       ( (= sKey "S")<br />         (cond<br />           ( (= sAxis "Z") (setq sAxis "X") )<br />           ( (= sAxis "X") (setq sAxis "Y") )<br />           ( (= sAxis "Y") (setq sAxis "Z") )<br />         )<br />       )<br />       ( (= sKey "W") (command "_.ucs" "_w") )<br />      ( (= sKey "F") (setq bLoop nil) (command "_.plan" "_c") )<br />       ( (= sKey "R")<br />         (command "_.ucs" "_r" "$_lkpt_UCS_Rotate_Save")<br />       )<br />       ( (= sKey "A")<br />         (setq sAngle (rtos rAngle 2 4)<br />               rAngle-in (getangle (strcat "\n指定转角[5/10/15/20/30/60/90/180] <" sAngle ">: "))<br />         )<br />         (if rAngle-in<br />           (setq rAngle (abs (/ (* rAngle-in 180.0) PI)))<br />         )<br />         (if (> rAngle 180.0)<br />           (setq rAngle (- rAngle 180.0))<br />         )<br />       )<br />       ( (= sKey "D")<br />         (setq bDirection (not bDirection)<br />               rAngle (- 0 rAngle)<br />         )<br />       )<br />     );end cond<br />   );end while<br />   (command "_.ucs" "_d" "$_lkpt_UCS_Rotate_Save")<br />   (setvar "CMDECHO" oldvar1)<br />   (setvar "DIMZIN" oldvar2)<br />   (setvar "UCSICON" oldvar3)<br />   (setq *error* olderr)<br />   (princ)<br /> );end defun C:lkpt:UCS:Rotate<br />

aeo

直接ucs不是更好

zhynt

旋转ｕｃｓ要这么复杂吗？

e2002

如果没有用处,我会写吗?hehe...
我现在在赶的图就是这样的,ucs不厌其烦,一直使用ExpressTools的rtucs,最后觉得rtucs每次要esc才能退出,且不时发生一些OSNAP设置被他弄没有的错误,干脆就自己写一个类似的.

ucs显然没这个方便,特别是在图中有多个特定角度拼接的建筑物时,(当然我也同时使用"UCS II"工具栏中的UCS下拉列表框).

有人可能会说: 用UCS by object嘛,不是很快?
实际上是很快,不过由于对象的不同属性,结果转成的UCS的X,,Y时常与所希望的恰好相反.

另 :  昨天晚上新加 F选项 : 退出并planiew the UCS

zhynt

好！我明白了，这对于建模来说真是太好了。还有就是目前那个“Ｆ”选项好像没有加上去嘛。能否将程序再贴一次。

e2002

我直接改一下吧...

这样的工具你不遇到具体工作时想不到需要去编写,这回实在是赶得要命,没办法,不写一个,画图太慢来不及

aeo

咱们讨论一下怎么更快.
我的方法:定义快捷键,比如ctrl+1,ctrl+2.. autohook,mnu,等都可以.
把你的几个特定角度定义进去.肯定比你的快.