求ucs的快速转换lsp

emch

请教大家，有没有这的代码。就是 先执行 ucs 然后在平面上指定新的ucs后，接着执行 plan 调整视图到新的ucs系统，用一个命令执行。谢谢：）

ㄘ丶转裑ㄧ灬

1. (defun C:gv (/ os ctscale tt pt pt1 pt2 pt3 by ang)
   
2.   (setvar "CMDECHO" 0)
   
3.   (setvar "ucsfollow" 0)
   
4.   (setvar "regenmode" 1)
   
5.   (setq os (getvar "OSMODE"))    ; (if (= cts nil)(setq cts 100))
   
6. ;;;; (setq ctscale (getreal (strcat "\n出图比例(1:?) <" (rtos cts 2 0) ">:")))
   
7. ;;;; (if (= ctscale nil)(setq ctscale cts))
   
8. ;;;; (setq cts ctscale)
   
9.   (setq ctscale 100)
   
10.   (initget "Y W")
    
11.   (setq tt (getkword "\n世界坐标系(W)/<垂直显示>: "))
    
12.   (if (or (= tt "w") (= tt "W"))
    
13.     (progn
    
14.       (command "plan" "w")
    
15.       (command "ucs" "w")
    
16.       (command "view" "r" "dz")
    
17.       (setq ptt nil)
    
18.       (command "regen")
    
19.     )
    
20.     (progn
    
21.       (if (= ptt nil)
    
22.   (command "view" "s" "dz")
    
23.       )
    
24.       (setvar "osmode" 513)
    
25.       (setq pt1 (getpoint "\n点取Y轴原点<退出>:"))
    
26.       (if pt1
    
27.   (progn
    
28.     (setq pt2 (getpoint "\n选择Y轴方向<退出>:"))
    
29.     (if pt2
    
30.       (progn
    
31.         (setq ang (angle pt1 pt2))
    
32.         (command "color" "250")
    
33.         (setq pt3 (polar pt1 (- ang (/ pi 2)) (* 0.1 ctscale)))
    
34.         (setvar "osmode" (+ 16384 os))
    
35.         (command "line" pt1 pt3 "")
    
36.         (command "color" "Bylayer")
    
37.         (setq pt (entlast))
    
38.         (command "ucs" "e" pt)
    
39.         (command "plan" "")
    
40.         (setq ptt  '
    
41.        (0 0)
    
42.         )
    
43.         (setq by (* 150 ctscale))
    
44.         (command "zoom" "c" ptt by)
    
45.         (entdel pt)
    
46.         (command "regen")
    
47.       )  ;;;;progn
    
48.     )  ;;;;if pt2
    
49.   )  ;;;;progn
    
50.       );;;;if pt1
    
51.       (setvar "osmode" os)
    
52.     );;;;progn
    
53.   );;;;if tt
    
54.   (princ)
    
55. )

(defun C:gv (/ os ctscale tt pt pt1 pt2 pt3 by ang)<br />   (setvar "CMDECHO" 0)<br />   (setvar "ucsfollow" 0)<br />   (setvar "regenmode" 1)<br />   (setq os (getvar "OSMODE"))    ; (if (= cts nil)(setq cts 100))<br /> ;;;; (setq ctscale (getreal (strcat "\n出图比例(1:?) <" (rtos cts 2 0) ">:")))<br /> ;;;; (if (= ctscale nil)(setq ctscale cts))<br /> ;;;; (setq cts ctscale)<br />   (setq ctscale 100)<br />   (initget "Y W")<br />   (setq tt (getkword "\n世界坐标系(W)/<垂直显示>: "))<br />   (if (or (= tt "w") (= tt "W"))<br />     (progn<br />       (command "plan" "w")<br />       (command "ucs" "w")<br />       (command "view" "r" "dz")<br />       (setq ptt nil)<br />       (command "regen")<br />     )<br />     (progn<br />       (if (= ptt nil)<br />   (command "view" "s" "dz")<br />       )<br />       (setvar "osmode" 513)<br />       (setq pt1 (getpoint "\n点取Y轴原点<退出>:"))<br />       (if pt1<br />   (progn<br />     (setq pt2 (getpoint "\n选择Y轴方向<退出>:"))<br />     (if pt2<br />       (progn<br />         (setq ang (angle pt1 pt2))<br />         (command "color" "250")<br />         (setq pt3 (polar pt1 (- ang (/ pi 2)) (* 0.1 ctscale)))<br />         (setvar "osmode" (+ 16384 os))<br />         (command "line" pt1 pt3 "")<br />         (command "color" "Bylayer")<br />         (setq pt (entlast))<br />         (command "ucs" "e" pt)<br />         (command "plan" "")<br />         (setq ptt  '<br />        (0 0)<br />         )<br />         (setq by (* 150 ctscale))<br />         (command "zoom" "c" ptt by)<br />         (entdel pt)<br />         (command "regen")<br />       )  ;;;;progn<br />     )  ;;;;if pt2<br />   )  ;;;;progn<br />       );;;;if pt1<br />       (setvar "osmode" os)<br />     );;;;progn<br />   );;;;if tt<br />   (princ)<br /> )

emch

谢谢 转身：）

刚才使用的时候发现一个问题，从垂直显示到世界坐标系后，世界坐标系还是偏的，希望再完善一下，谢谢：）
还有个小提议，能不能改成选X坐标，平常X坐标用的多，Y坐标用的少。

love_cq

非常感谢大神分享。
请教下这代码是用什么写的呢？复制过去以后行号都乱了。有点麻烦。