标注距离和高程

qazwsx_qazwsx

请高手帮忙写这个过程的Lisp代码……

Lisp程序：标注距离和高程
实现下列过程：
用户执行命令，程序调用Lisp，命令行提示：选择参考点；
用户选择参考点，程序获取参考点的坐标X0，Y0，命令行提示：输入参考点的实际高程；
用户输入参考点的实际高程H0，程序获取参考点的实际高程H0，命令行提示：选择标注点；
用户选择标注点，程序获取标注点的坐标X，Y，并标注该点的距离和高程（X-X0，Y-Y0+H0），命令行提示选择下一点；
用户选择标注点，（同上一行）……。

chucklehead

学习学习，谢谢

hero07249

湘源高程方面挺齐全

tmzg2015

这是我现在用的,输入该基准点X=高程,Y0=0;编码如下:
(defun c:bzzb()
   (if (= hzt nil) (setq hzt 1))
   (setq thzt hzt)
   (setq thzt (getdist (strcat "\n 文字高度<" (rtos thzt) ">:")))
   (if thzt (setq hzt thzt))
   (command "style" "standard" "黑体" hzt 1 "" "" "")
(initget 1 "A B  ")
(setq gclx (getkword "\n 绝对坐标(A) / 相对于某点的坐标(B) <A>:"))
(setq pt0 (list 0 0))
(cond
      ((= gclx "A")
        (progn (setq xpt0 0)
         (setq ypt0 0)
  )
            
      )  
      ((= gclx "B")
        (progn (setq pt0 (getpoint "\n 点取基准坐标点位置:"))
          (setq xpt0 (getreal "\n 该基准点X=:"))
   (setq ypt0 (getreal "\n 该基准点y=:"))
  )
      )
      ((= gclx "")
        (progn (setq xpt0 0)
         (setq ypt0 0)
  )
            
      )
      ((= gclx nil)
        (progn (setq xpt0 0)
         (setq ypt0 0)
  )
            
      )
      (t nil)
)
   
(if (= wz nil)(setq wz "TR"))
  
        (initget 1 "TL  TR BL  BR  ")
   (setq tWZ (getkword (strcat "\n文字位于标注点的方位: 左上(TL) /右上(TR)/ 左下(BL) /右下(BR) <" wz ">:")))
        (if (/= twz "") (setq wz twz))
(setq os (getvar "osmode"))
     (while (setq pt (getpoint "\n 点取标注点位置:"))
   (if (= wz "TR")(setq p1 (list (+ (nth 0 pt) (* hzt 5)) (+ (nth 1 pt) (* hzt 5)))))
   (if (= wz "TL")(setq p1 (list (- (nth 0 pt) (* hzt 5)) (+ (nth 1 pt) (* hzt 5)))))
   (if (= wz "BL")(setq p1 (list (- (nth 0 pt) (* hzt 5)) (- (nth 1 pt) (* hzt 5)))))
   (if (= wz "BR")(setq p1 (list (+ (nth 0 pt) (* hzt 5)) (- (nth 1 pt) (* hzt 5)))))  
                (command "point" pt)
  (setvar "osmode" 0)
    (setq  xpt (+ (- (nth 1 pt) (nth 1 pt0)) xpt0) ypt (+ (- (nth 0 pt) (nth 0 pt0)) ypt0))
                (command "leader" pt p1 "" (strcat "标高" (bl3 xpt)) (strcat "距离" (bl3 ypt)) "")
    (setvar "osmode" os)
  )
  
);defun
(defun bl3(x)
   (setq sintx (rtos  x 2 3))
   (setq abx (abs x))
   (setq sxsd (rtos (- abx  (fix abx )) 2 3))
   (setq lx (strlen sxsd))
   (if (= lx 1) (setq s (strcat sintx ".000")))
   (if (= lx 3) (setq s (strcat sintx "00")))
   (if (= lx 4) (setq s (strcat sintx "0")))
   (if (= lx 5) (setq s (strcat sintx "")))
   (princ s)
)
但这个变量——
文字位于标注点的方位: 左上(TL) /右上(TR)/ 左下(BL) /右下(BR)
不能用默认值，没有中间选项，请高手修改！

至尊宝宝

感谢楼主分享！！！

力能

感谢大神！！！！好东西！！！！谢谢分享！！！

yaojing38

太好用了，，谢谢分享！！