单点设置UCS

newer · 发表于 2017-12-7 18:27:34

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 newer 于 2017-12-9 00:24 编辑

(defun c:XDTB_1PUCS ( / pt pt1 pt2 tf x)
(if (setq pt (getpoint "\n拾取目标坐标系内的一点<退出>:"))
(progn
(if (not #xd-var-global-coord)
(setq #xd-var-global-coord '(0 0 0))
)
(setq tf t)
(while tf
(if (and
(xdrx_initget "O")
(/= "" (setq pt2 (getstring (xdrx_prompt "\n输入该点在目标坐标系的坐标[O-原点](x,y,z)<"
(strcat (vl-princ-to-string (car #xd-var-global-coord)) "," (vl-princ-to-string (cadr #xd-var-global-coord)) "," (vl-princ-to-string (caddr #xd-var-global-coord)))
">:" t
)
)
)
)
(setq pt2 (if (= pt2 "O")
"0,0,0"
pt2
)
)
(setq pt2 (xdrx_string_regexps "^(-?[0-9.]+),(-?[0-9.]+),(-?[0-9.]+)$"
pt2
)
)
)
(progn
(setq #xd-var-global-coord (mapcar
'(lambda (x)
(atof x)
)
(xdrx_string_split (car pt2) ",")
)
tf nil
)
)
(progn
(if (/= "" pt2)
(xdrx_prompt "\n输入格式不对, 按<x,y,z>格式重新输入.")
(setq tf nil)
)
)
)
)
(setq pt (trans pt 1 0)
pt1 (mapcar
'-
pt
#xd-var-global-coord
)
)
(xdrx_ucs_set pt1 (getvar "viewdir"))
(xdrx_prompt "\n已经设置当前坐标系.")
)
)
(princ)
)

(defun c:XDTB_1PUCS ( / pt pt1 pt2 tf x) 
  (if (setq pt (getpoint "\n拾取目标坐标系内的一点<退出>:")) 
    (progn 
      (if (not #xd-var-global-coord) 
        (setq #xd-var-global-coord '(0 0 0)) 
      ) 
      (setq tf t) 
      (while tf 
        (if (and 
              (xdrx_initget "O") 
 
              (/= "" (setq pt2 (getstring (xdrx_prompt "\n输入该点在目标坐标系的坐标[O-原点](x,y,z)<" 
                                                       (strcat (vl-princ-to-string (car #xd-var-global-coord)) "," (vl-princ-to-string (cadr #xd-var-global-coord)) "," (vl-princ-to-string (caddr #xd-var-global-coord))) 
                                                       ">:" t 
                                          ) 
                               ) 
                     ) 
              ) 
              (setq pt2 (if (= pt2 "O") 
                          "0,0,0" 
                          pt2 
                        ) 
              ) 
              (setq pt2 (xdrx_string_regexps "^(-?[0-9.]+),(-?[0-9.]+),(-?[0-9.]+)$" 
                                             pt2 
                        ) 
              ) 
            ) 
          (progn 
            (setq #xd-var-global-coord (mapcar 
                                         '(lambda (x) 
                                            (atof x) 
                                          ) 
                                         (xdrx_string_split (car pt2) ",") 
                                       ) 
                  tf nil 
            ) 
          ) 
          (progn 
            (if (/= "" pt2) 
              (xdrx_prompt "\n输入格式不对, 按<x,y,z>格式重新输入.") 
              (setq tf nil) 
            ) 
          ) 
        ) 
      ) 
      (setq pt (trans pt 1 0) 
            pt1 (mapcar 
                  '- 
                  pt 
                  #xd-var-global-coord 
                ) 
      ) 
      (xdrx_ucs_set pt1 (getvar "viewdir")) 
      (xdrx_prompt "\n已经设置当前坐标系.") 
    ) 
  ) 
  (princ) 
)

kqqt6236 · 发表于 2017-12-8 00:05:01

学习一下。

longer1000 · 发表于 2017-12-8 00:28:41

学习一下。

账号		自动登录	找回密码
密码			立即注册

[工具] 单点设置UCS

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。