求ucs的快速转换lsp
请教大家，有没有这的代码。就是 先执行 ucs 然后在平面上指定新的ucs后，接着执行 plan 调整视图到新的ucs系统，用一个命令执行。谢谢：）(defun C:gv (/ os ctscale tt pt pt1 pt2 pt3 by ang)
(setvar "CMDECHO" 0)
(setvar "ucsfollow" 0)
(setvar "regenmode" 1)
(setq os (getvar "OSMODE")) ; (if (= cts nil)(setq cts 100))
;;;; (setq ctscale (getreal (strcat "\n出图比例(1:?) <" (rtos cts 2 0) ">:")))
;;;; (if (= ctscale nil)(setq ctscale cts))
;;;; (setq cts ctscale)
(setq ctscale 100)
(initget "Y W")
(setq tt (getkword "\n世界坐标系(W)/<垂直显示>: "))
(if (or (= tt "w") (= tt "W"))
(progn
(command "plan" "w")
(command "ucs" "w")
(command "view" "r" "dz")
(setq ptt nil)
(command "regen")
)
(progn
(if (= ptt nil)
(command "view" "s" "dz")
)
(setvar "osmode" 513)
(setq pt1 (getpoint "\n点取Y轴原点<退出>:"))
(if pt1
(progn
(setq pt2 (getpoint "\n选择Y轴方向<退出>:"))
(if pt2
(progn
(setq ang (angle pt1 pt2))
(command "color" "250")
(setq pt3 (polar pt1 (- ang (/ pi 2)) (* 0.1 ctscale)))
(setvar "osmode" (+ 16384 os))
(command "line" pt1 pt3 "")
(command "color" "Bylayer")
(setq pt (entlast))
(command "ucs" "e" pt)
(command "plan" "")
(setq ptt'
(0 0)
)
(setq by (* 150 ctscale))
(command "zoom" "c" ptt by)
(entdel pt)
(command "regen")
);;;;progn
);;;;if pt2
);;;;progn
);;;;if pt1
(setvar "osmode" os)
);;;;progn
);;;;if tt
(princ)
)
本帖最后由 emch 于 2015-10-18 16:20 编辑
谢谢 转身：）
刚才使用的时候发现一个问题，从垂直显示到世界坐标系后，世界坐标系还是偏的，希望再完善一下，谢谢：）
还有个小提议，能不能改成选X坐标，平常X坐标用的多，Y坐标用的少。 非常感谢大神分享。
请教下这代码是用什么写的呢？复制过去以后行号都乱了。有点麻烦。
页:
[1]