[LISP程序]：标注的坐标入高程值(回车为空值

puzhixing123

(defun c:zb (/ os pt y x p1 p2 h str-h test-xy x1 x2 y1 sh ts txt -ts ts1 l tyu tyd a b ph)
  (setvar "cmdecho" 0)
  (command "ucs" "w")
  (setq os (getvar "osmode"))
  (command "osnap" "int,end")
  (setq pt (getpoint "\n请点取欲标注坐标的点:"))
  (PRINC PT)
  (command "osnap" "non")
  (command "pline" pt "")
  (command "osnap" "off")
  (command "ucs" "v")
  ;(setq p1 (getpoint (trans pt 0 1) "\n标注线起点:"))
  (setq p1 (getpoint  "\n标注线起点:"))
  (PRINC P1)
  (setq p2 (getpoint  "\n标注线终点方向:"))
  (PRINC P2)
  ;(setq h (strcase (getstring t "\n请输入高程值(回车为空值):") 1))
  (setq h (getstring  "\n请输入高程值(回车为空值):"))
  (if (= (strlen h) 0)
   (setq str-h h)
   (setq str-h (strcat "H=" h))
  )
  (setq test-xy (getstring  "\n标注坐标值是否需互换?<回车为否/Yes>:"))
  (if (= (strlen test-xy) 0)
    (setq x (strcat " X=" (rtos (car pt) 2 3)))
    (setq y (strcat " Y=" (rtos (cadr pt) 2 3)))
  )
  (if (/= (strlen test-xy) 0)
    (setq x (strcat " X=" (rtos (cadr pt) 2 3)))
    (setq y (strcat " Y=" (rtos (car pt) 2 3)))
  )
  (setq x1 (car p1))
  (setq y1 (cadr p1))
  (setq x2 (car p2))
  (setq y2 (cadr p2))
  (setq sh (cAr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
  (setq w  (cdr (assoc 41 (tblsearch "style" (getvar "textstyle")))))
  
  (setq ts (if (> sh 0)
               (SETQ sh (getvar "TEXTSIZE"))
           )
  )

  (setq txt-ts (strcat "\n文本尺寸为" (rtos ts 2 1)))
  (prompt txt-ts)
  (setq ts1 (getreal "\n文本尺寸为<回车为默认值>"))
  (if (= ts nil)
     (setq ts ts)
     (setq ts ts1)
  )
  (setq l (* (max (strlen y) (strlen x)) ts 0.9 w))
  (setq tyu (+ y1 (* ts 0.5)))
  (setq tyd (- y1 (* ts 1.5)))
  (if (> x1 x2)
      (setq x2 (- x1 1))
      (setq y2 (+ y1 1))
  )
  (command "pline" "@0,0,0" "w" 0 0 p1 (list x2 y1) "")
  (if (> x1 x2)
      (setq a x2)
      (setq a x1)
  )
  (if (> x1 x2)
      (setq b x1)
      (setq b x2)
  )
  (if (> sh 0)
     (progn
        (command "text" (list a tyd) TS1 0 y "")
        (command 'text" (list a tyu) TS1 0 x "")
     )
     (progn
        (command "text" (list a tyd) ts 0 y "")
        (command 'text" (list a tyu) ts 0 x "")
     )
  )
  (if (/= "H=" h)
     (progn
       (if (> x2 x1)
         (setq ph (list (+ x2 (/ ( * ts w ) 2)) (- y1 (/ ts 2))))
         (setq ph (list (- x2 (* (strlen str-h) ts w)) (- y1 (/ ts 2))))
       )
       (if (> sh 0)
         (command "text" ph 0 str-h "")
         (command "text" ph ts 0 str-h "")
       )
     )
   )
  (setvar "osmode" os)
  (command "ucs" "w")
  (command "redraw")
)

*-*9