求助LISP高手，坐标标注程序改进方案

○Only°尐影

我绘制道路横断图时想标注距中桩的偏距和高程，此程序的相对坐标标注可满足要求，唯一不足的地方是我想把引线修改为竖直方向，X,Y分别在引线两端，如图所示：高手请帮帮小弟，不胜感激！！！！！！！

ZZXXQQ

1. (defun c:bzzb()
   
2. (setq oldzin (getvar "DIMZIN"))
   
3. (setvar "DIMZIN" 0)
   
4. (if (= hzt nil) (setq hzt 1))
   
5. (setq thzt hzt)
   
6. (setq thzt (getdist (strcat "\n 文字高度<" (rtos thzt) ">:")))
   
7. (if thzt (setq hzt thzt))
   
8. (command "style" "standard" "黑体" hzt 1 "" "" "")
   
9. (initget 1 "A B  ")
   
10. (setq gclx (getkword "\n 绝对坐标(A) / 相对于某点的坐标(B) <A>:"))
    
11. (if (= gclx "B")
    
12.   (setq pt0 (getpoint "\n 点取基准坐标点位置: "))
    
13.   (setq pt0 (list 0 0))
    
14. )
    
15. (setq os (getvar "osmode"))
    
16. (while (and (setq pt (getpoint "\n点取标注点位置: "))
    
17.              (setq pt1 (getpoint pt "\n文字点: ")))
    
18.   (setq p1 (polar pt1 0 hzt))
    
19.   (setq p2 (polar pt1 pi hzt))
    
20.   (command "point" pt)
    
21.   (setvar "osmode" 0)
    
22.   (setq pt1 (mapcar '- pt pt0))
    
23.   (setq xpt (rtos (cadr pt1) 2 3) ypt (rtos (car pt1) 2 3))
    
24.   (setq l (* hzt (max (strlen xpt) (strlen ypt))))
    
25.   (setq pt2 (polar pt1 (/ pi 2) l))
    
26.   (command "_.PLINE" pt pt1 pt2 "")
    
27.   (command "_.TEXT" "ML" p2 90 (strcat "x=" xpt))
    
28.   (command "_.TEXT" "ML" p1 90 (strcat "y=" ypt))
    
29.   (setvar "osmode" os)
    
30. )
    
31. (setvar "DIMZIN" oldzin)
    
32. );defun
    

(defun c:bzzb()<br /> (setq oldzin (getvar "DIMZIN"))<br /> (setvar "DIMZIN" 0)<br /> (if (= hzt nil) (setq hzt 1))<br /> (setq thzt hzt)<br /> (setq thzt (getdist (strcat "\n 文字高度<" (rtos thzt) ">:")))<br /> (if thzt (setq hzt thzt))<br /> (command "style" "standard" "黑体" hzt 1 "" "" "")<br /> (initget 1 "A B  ")<br /> (setq gclx (getkword "\n 绝对坐标(A) / 相对于某点的坐标(B) <A>:"))<br /> (if (= gclx "B")<br />   (setq pt0 (getpoint "\n 点取基准坐标点位置: "))<br />   (setq pt0 (list 0 0))<br /> )<br /> (setq os (getvar "osmode"))<br /> (while (and (setq pt (getpoint "\n点取标注点位置: "))<br />              (setq pt1 (getpoint pt "\n文字点: ")))<br />   (setq p1 (polar pt1 0 hzt))<br />   (setq p2 (polar pt1 pi hzt))<br />   (command "point" pt)<br />   (setvar "osmode" 0)<br />   (setq pt1 (mapcar '- pt pt0))<br />   (setq xpt (rtos (cadr pt1) 2 3) ypt (rtos (car pt1) 2 3))<br />   (setq l (* hzt (max (strlen xpt) (strlen ypt))))<br />   (setq pt2 (polar pt1 (/ pi 2) l))<br />   (command "_.PLINE" pt pt1 pt2 "")<br />   (command "_.TEXT" "ML" p2 90 (strcat "x=" xpt))<br />   (command "_.TEXT" "ML" p1 90 (strcat "y=" ypt))<br />   (setvar "osmode" os)<br /> )<br /> (setvar "DIMZIN" oldzin)<br /> );defun<br />

○Only°尐影

程序达到了我想要的结果，谢谢超级版主，请问x,y坐标还能不能改成任意角度标注（只要保证标注点和XY坐标在一条直引线上就好），麻烦版主再费点力，小弟再次感谢！！！

ZZXXQQ

2. ;坐标标注 ZZXXQQ 2013.5.12 2013.5.15改
   
3. (defun c:bzzb()
   
4. (setq oldzin (getvar "DIMZIN"))
   
5. (setvar "DIMZIN" 0)
   
6. (if (= hzt nil) (setq hzt 1))
   
7. (setq thzt hzt)
   
8. (setq thzt (getdist (strcat "\n 文字高度<" (rtos thzt) ">:")))
   
9. (if thzt (setq hzt thzt))
   
10. (command "style" "standard" "黑体" hzt 1 "" "" "")
    
11. (initget 1 "A B  ")
    
12. (setq gclx (getkword "\n 绝对坐标(A) / 相对于某点的坐标(B) <A>:"))
    
13. (if (= gclx "B")
    
14.   (setq pt0 (getpoint "\n 点取基准坐标点位置: "))
    
15.   (setq pt0 (list 0 0))
    
16. )
    
17. (setq os (getvar "osmode"))
    
18. (while (and (setq pt (getpoint "\n点取标注点位置: "))
    
19.              (setq pt1 (getpoint pt "\n文字点: ")))
    
20.   (setq ang (angle pt pt1))
    
21.   (setq p1 (polar pt1 (+ (/ pi -2) ang) hzt))
    
22.   (setq p2 (polar pt1 (+ (/ pi 2) ang) hzt))
    
23.   (command "point" pt)
    
24.   (setvar "osmode" 0)
    
25.   (setq pt1 (mapcar '- pt pt0))
    
26.   (setq xpt (rtos (cadr pt1) 2 3) ypt (rtos (car pt1) 2 3))
    
27.   (setq l (* hzt (max (strlen xpt) (strlen ypt))))
    
28.   (setq pt2 (polar pt1 ang l))
    
29.   (setq an (/ (* ang 180) pi))
    
30.   (command "_.PLINE" pt pt1 pt2 "")
    
31.   (command "_.TEXT" "ML" p2 an (strcat "x=" xpt))
    
32.   (command "_.TEXT" "ML" p1 an (strcat "y=" ypt))
    
33.   (setvar "osmode" os)
    
34. )
    
35. (setvar "DIMZIN" oldzin)
    
36. );defun
    

;坐标标注 ZZXXQQ 2013.5.12 2013.5.15改<br /> (defun c:bzzb()<br /> (setq oldzin (getvar "DIMZIN"))<br /> (setvar "DIMZIN" 0)<br /> (if (= hzt nil) (setq hzt 1))<br /> (setq thzt hzt)<br /> (setq thzt (getdist (strcat "\n 文字高度<" (rtos thzt) ">:")))<br /> (if thzt (setq hzt thzt))<br /> (command "style" "standard" "黑体" hzt 1 "" "" "")<br /> (initget 1 "A B  ")<br /> (setq gclx (getkword "\n 绝对坐标(A) / 相对于某点的坐标(B) <A>:"))<br /> (if (= gclx "B")<br />   (setq pt0 (getpoint "\n 点取基准坐标点位置: "))<br />   (setq pt0 (list 0 0))<br /> )<br /> (setq os (getvar "osmode"))<br /> (while (and (setq pt (getpoint "\n点取标注点位置: "))<br />              (setq pt1 (getpoint pt "\n文字点: ")))<br />   (setq ang (angle pt pt1))<br />   (setq p1 (polar pt1 (+ (/ pi -2) ang) hzt))<br />   (setq p2 (polar pt1 (+ (/ pi 2) ang) hzt))<br />   (command "point" pt)<br />   (setvar "osmode" 0)<br />   (setq pt1 (mapcar '- pt pt0))<br />   (setq xpt (rtos (cadr pt1) 2 3) ypt (rtos (car pt1) 2 3))<br />   (setq l (* hzt (max (strlen xpt) (strlen ypt))))<br />   (setq pt2 (polar pt1 ang l))<br />   (setq an (/ (* ang 180) pi))<br />   (command "_.PLINE" pt pt1 pt2 "")<br />   (command "_.TEXT" "ML" p2 an (strcat "x=" xpt))<br />   (command "_.TEXT" "ML" p1 an (strcat "y=" ypt))<br />   (setvar "osmode" os)<br /> )<br /> (setvar "DIMZIN" oldzin)<br /> );defun<br />

风雨依然

版主 强大啊 收藏了 顶起

nw3177811

○Only°尐影 发表于 2013-5-13 19:31
程序达到了我想要的结果，谢谢超级版主，请问x,y坐标还能不能改成任意角度标注（只要保证标注点和XY坐标在一 ...

你好，改完后的能给我发一个吗？

zwf100

厉害，版主，学习了