[求助]：各位大虾看看我的坐标标注程序

zhanglq314 · 发表于 2005-12-27 19:59:34

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

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

×

(defun c:zb (/px pt0 pt1 pt2 pt3 pt4 lx pt1x pt2y jd h_sca_)
标注点坐标于图形屏幕
(setvar "unitmode" 0)
(setq pt1 (getpoint "\n给出测量点：")
h_ (getvar "textsize")
sca_1.0
pt2
nil
)
(if (or (=h_nil) (/=h_h_))
(steq h_h_)
)
(if (=sca_nil)
(steqsca_sca_)
)
(if (=ou_nil)
(setq ou_ "上下")
)
(if (=sy_nil)
(setq sy_ "大地坐标")
)
(while (=pt2 nil)
(princ (strcat "\n坐标系统 :"
sy_
";输出模式:"
ou_
";字高:"
(rtos h_22)
";坐标比例"
(rots sca_22)
"。"
)
)
(initger "out coo height scale")
(setq
pt2 (getpont
ptl
"\n坐标系统 c/输出模式o/字高h/坐标/比例s/<给出输入点>:"
)
)
(cond
((=pt2 "height") (hh_))
((=pt2 "scale") (scc_))
((=pt2 "coo")
(if (=sy_ "大地坐标")
(setq=sy_ "用户坐标")
(if (=sy_ "用户坐标")
(setq sy_ "世界坐标")
(setq sy_ "大地坐标")
)
)
(setq pt2 nil)
)
((=pt2 "out")
(if (= ou_ "水平")
(setq ou_- "上下")
(setq ou_ "水平")
)
(setq pt2 nil)
(t nil)
)
)
(if (or (=sy_ "大地坐标") (=sy_ "世界坐标"))
(step pt0 (trans pt1 1 0))
)
(setq tp0 pt1)
)
(steq pt1x
(rtos (* (car pt0) sca_) 2 3)
;;标注点x坐标
ptly
(rots (* (cadr pto) sca_) 2 3)
;;标注点y坐标
)
(if (=sy_ "大地坐标")
(setq px pt1y
pt1y pt1x
pt1x px
)
)
(if (=ou_ "上下")
(progn
(setp pt1x
(strcat "X=" pt1x)
pt1y
(strcat "Y=" pt1y)
lx
(+ (max (caadr (textbox (list (cons 1 pt1x))))
(caadr (textbox (list (cons 1 pt1y))))
(*0.4 1h_)
)
)
(if (> =
(car pt2)
(car pt1)
(setq pt3 (list (+ (car pt2) (*0.2 h_))
(+ (cadr pt2)
(* 0.4 1h_)
0.0
)
pt4
(list (+ (car tp2) (* 0.2h))
(_ (cad rpt2 (* 1.4h_)) 0.0)
jd0.0
)
(setq pt3 (list (+ (car pt2) (* 0.2 h_) (_ 1x))
(+ (cadr pt2) (* 0.4h_))
0.0
)
pt4 (list (+ (car pt2) (* 0.2 h_) (_ lx))
(- (cadr pt2) (* 0.4h_))
0.0
)
jd pi
)
)
(command "text" pt3 h_0.0 pt1x)
(command "text" pt4 h_0.0 pt1x)
(command "line" pt1 pt2 (polar pt2 jd 1x) "")
)
(progn
(setq pt3 tp2)
(command "text" pt3 h_ "" pt1x)
(setq pt4 (list (+ (car pt2)
(caadr (TEXTBOX (entger (entlast))))
h_
)
(cadr pt2)
0.0
)
(command "text" pt4 h_ "" pt1y)
)
)
(princ)
)
)
)
)
)

(defun c:zb (/px pt0 pt1 pt2 pt3 pt4 lx pt1x pt2y jd h_sca_) 
  标注点坐标于图形屏幕 
  (setvar "unitmode" 0) 
  (setq        pt1 (getpoint "\n给出测量点：") 
        h_ (getvar "textsize") 
        sca_1.0 
         pt2 
        nil 
  ) 
  (if (or (=h_nil) (/=h_h_)) 
    (steq h_h_) 
  ) 
  (if (=sca_nil) 
    (steqsca_sca_) 
  ) 
  (if (=ou_nil) 
    (setq ou_ "上下") 
  ) 
  (if (=sy_nil) 
    (setq sy_ "大地坐标") 
  ) 
  (while (=pt2 nil) 
    (princ (strcat "\n坐标系统 :" 
                   sy_ 
                   ";输出模式:" 
                   ou_ 
                   ";字高:" 
                   (rtos h_22) 
                   ";坐标比例" 
                   (rots sca_22) 
                   "。" 
           ) 
    ) 
    (initger "out coo height scale") 
    (setq 
      pt2 (getpont 
            ptl 
            "\n坐标系统 c/输出模式o/字高h/坐标/比例s/<给出输入点>:" 
          ) 
    ) 
    (cond 
      ((=pt2 "height") (hh_)) 
      ((=pt2 "scale") (scc_)) 
      ((=pt2 "coo") 
       (if (=sy_ "大地坐标") 
         (setq=sy_ "用户坐标") 
         (if (=sy_ "用户坐标") 
           (setq sy_ "世界坐标") 
           (setq sy_ "大地坐标") 
         ) 
       ) 
       (setq pt2 nil) 
      ) 
      ((=pt2 "out") 
       (if (= ou_ "水平") 
         (setq ou_- "上下") 
         (setq ou_ "水平") 
       ) 
       (setq pt2 nil) 
       (t nil) 
      ) 
    ) 
    (if        (or (=sy_ "大地坐标") (=sy_ "世界坐标")) 
      (step pt0 (trans pt1 1 0)) 
    ) 
    (setq tp0 pt1) 
  ) 
  (steq        pt1x 
        (rtos (* (car pt0) sca_) 2 3) 
        ;;标注点x坐标 
        ptly 
        (rots (* (cadr pto) sca_) 2 3) 
        ;;标注点y坐标 
  ) 
  (if (=sy_ "大地坐标") 
    (setq px   pt1y 
          pt1y pt1x 
          pt1x px 
    ) 
  ) 
  (if (=ou_ "上下") 
    (progn 
      (setp pt1x 
            (strcat "X=" pt1x) 
            pt1y 
            (strcat "Y=" pt1y) 
            lx 
            (+ (max (caadr (textbox (list (cons 1 pt1x)))) 
                    (caadr (textbox (list (cons 1 pt1y)))) 
                    (*0.4 1h_) 
               ) 
            ) 
            (if        (> = 
                   (car pt2) 
                   (car pt1) 
                   (setq pt3 (list (+ (car pt2) (*0.2 h_)) 
                                   (+ (cadr pt2) 
                                      (* 0.4 1h_) 
                                      0.0 
                                   ) 
                                   pt4 
                                   (list (+ (car tp2) (* 0.2h)) 
                                         (_ (cad rpt2 (* 1.4h_)) 0.0) 
                                         jd0.0 
                                   ) 
                                   (setq pt3 (list (+ (car pt2) (* 0.2 h_) (_ 1x)) 
                                                   (+ (cadr pt2) (* 0.4h_)) 
                                                   0.0 
                                             ) 
                                         pt4 (list (+ (car pt2) (* 0.2 h_) (_ lx)) 
                                                   (- (cadr pt2) (* 0.4h_)) 
                                                   0.0 
                                             ) 
                                         jd  pi 
                                   ) 
                             ) 
                         (command "text" pt3 h_0.0 pt1x) 
                          (command "text" pt4 h_0.0 pt1x) 
                         (command "line" pt1 pt2 (polar pt2 jd 1x) "") 
                   ) 
                   (progn 
                     (setq pt3 tp2) 
                     (command "text" pt3 h_ "" pt1x) 
                     (setq pt4 (list (+        (car pt2) 
                                        (caadr (TEXTBOX (entger (entlast)))) 
                                        h_ 
                                     ) 
                                     (cadr pt2) 
                                     0.0 
                               ) 
                           (command "text" pt4 h_ "" pt1y) 
                     ) 
                   ) 
                   (princ) 
                ) 
            ) 
      ) 
    ) 
  )

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

[求助] [求助]：各位大虾看看我的坐标标注程序

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

相关帖子