发个xy坐标标注，应急用~

77077

功能简单，主要用于应急。
欢迎拿去应急~~~

2. (defun c:bzxy(/ os h jd pt1 pt2 pt3 pt4 pt5 strx stry lx ly l1 ptx1 ptx2 a b)
   
3.   (setq os (getvar "osmode"));保存捕捉模式
   
4.   (setq h (getreal (strcat "\n请键入文字高度<5>:")))
   
5.   (if (null h) (setq h 5))
   
6.   (setq jd (getint "\n请键入保留小数位数<3>"))
   
7.   (if (null jd) (setq jd 3))
   
8. (while (and
   
9.         (setvar "osmode" 37);设置捕捉模式,交点+圆心+端点
   
10.         (setq pt1 (getpoint "\n请点选要标注坐标的点:"))
    
11.         )
    
12.       (setvar "osmode" 0);为避免意外情况,关闭捕捉
    
13.       (setq pt2 (getpoint pt1 "\n请点选坐标放置的位置:"))
    
14. (setq strx (rtos (car pt1) 2 jd)
    
15.       stry (rtos (cadr pt1) 2 jd)
    
16.       lx (strlen strx)
    
17.       ly (strlen stry)
    
18.       l1 (max lx ly);最长字符数
    
19.       a (* l1 h 1.1);横线长度
    
20.       b (* h 0.2);文字偏移横线的距离
    
21.       ptx1 (car pt1)
    
22.       ptx2 (car pt2)
    
23.       )
    
24. (if (> ptx2 ptx1) ;左右判断
    
25.   (setq pt3 (polar pt2 0 a);横线终点
    
26.         pt4 (polar pt2 (* 0.5 pi) b);X文字位置
    
27.         pt5 (polar pt2 (* 1.5 pi) (+ b h));Y文字位置
    
28.         )
    
29.   (setq pt3 (polar pt2 pi a)
    
30.         pt4 (polar pt3 (* 0.5 pi) b)
    
31.         pt5 (polar pt3 (* 1.5 pi) (+ b h))
    
32.         )
    
33. )
    
34. (mkpline "DM-坐标标注" (list pt1 pt2 pt3))
    
35. (mktext "DM-坐标标注" (strcat "X=" strx) pt4 h)
    
36. (mktext "DM-坐标标注" (strcat "Y=" stry) pt5 h)
    
37. )
    
38. (setvar "osmode" os)
    
39. (princ)
    
40. )

(defun c:bzxy(/ os h jd pt1 pt2 pt3 pt4 pt5 strx stry lx ly l1 ptx1 ptx2 a b)<br />   (setq os (getvar "osmode"));保存捕捉模式<br />   (setq h (getreal (strcat "\n请键入文字高度<5>:")))<br />   (if (null h) (setq h 5))<br />   (setq jd (getint "\n请键入保留小数位数<3>"))<br />   (if (null jd) (setq jd 3))<br /> (while (and<br />         (setvar "osmode" 37);设置捕捉模式,交点+圆心+端点<br />         (setq pt1 (getpoint "\n请点选要标注坐标的点:"))<br />         )<br />       (setvar "osmode" 0);为避免意外情况,关闭捕捉<br />       (setq pt2 (getpoint pt1 "\n请点选坐标放置的位置:"))<br /> (setq strx (rtos (car pt1) 2 jd)<br />       stry (rtos (cadr pt1) 2 jd)<br />       lx (strlen strx)<br />       ly (strlen stry)<br />       l1 (max lx ly);最长字符数<br />       a (* l1 h 1.1);横线长度<br />       b (* h 0.2);文字偏移横线的距离<br />       ptx1 (car pt1)<br />       ptx2 (car pt2)<br />       )<br /> (if (> ptx2 ptx1) ;左右判断<br />   (setq pt3 (polar pt2 0 a);横线终点<br />         pt4 (polar pt2 (* 0.5 pi) b);X文字位置<br />         pt5 (polar pt2 (* 1.5 pi) (+ b h));Y文字位置<br />         )<br />   (setq pt3 (polar pt2 pi a)<br />         pt4 (polar pt3 (* 0.5 pi) b)<br />         pt5 (polar pt3 (* 1.5 pi) (+ b h))<br />         )<br /> )<br /> (mkpline "DM-坐标标注" (list pt1 pt2 pt3))<br /> (mktext "DM-坐标标注" (strcat "X=" strx) pt4 h)<br /> (mktext "DM-坐标标注" (strcat "Y=" stry) pt5 h)<br /> )<br /> (setvar "osmode" os)<br /> (princ)<br /> )

2. (defun mktext (la str pt h);写文字
   
3.      (entmake (list
   
4.                  (cons 0 "TEXT")
   
5.                  (cons 1 str)
   
6.                  (cons 8 la)
   
7.                  (cons 10 pt)
   
8.                  (cons 40 h)
   
9.                )
   
10.     )
    
11. )
    
12. (defun mkpline (la lst);绘pl线
    
13.     (entmake (append (list
    
14.                    (cons 0 "LWPOLYLINE")
    
15.                    (cons 8 la)
    
16.                    (cons 100 "AcDbEntity")
    
17.                    (cons 100 "AcDbPolyline")
    
18.                    (cons 90 (length lst))
    
19.                    )
    
20.                 (mapcar '(lambda (pt)(cons 10 pt)) lst )
    
21.               )
    
22.    )
    
23. )

(defun mktext (la str pt h);写文字<br />      (entmake (list<br />                  (cons 0 "TEXT")<br />                  (cons 1 str)<br />                  (cons 8 la)<br />                  (cons 10 pt)<br />                  (cons 40 h)<br />                )<br />     )<br /> )<br /> (defun mkpline (la lst);绘pl线<br />     (entmake (append (list <br />                    (cons 0 "LWPOLYLINE")<br />                    (cons 8 la)<br />                    (cons 100 "AcDbEntity") <br />                    (cons 100 "AcDbPolyline")<br />                    (cons 90 (length lst))<br />                    )<br />                 (mapcar '(lambda (pt)(cons 10 pt)) lst )<br />               )<br />    )<br /> )

spp_wall

文字的图层怎么改？

香田里浪人

建议楼主添加(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零，不然最后一位是0时无法显示。

spp_wall

说错了 是文字的样式！！！

77077

spp_wall 发表于 2014-10-20 19:10
说错了 是文字的样式！！！

这个只是应急用的，所以功能不全。
你可以在标注之前，设定好你要的字体，并置为当前字体。。。

spp_wall

77077 发表于 2014-10-20 19:24
这个只是应急用的，所以功能不全。
你可以在标注之前，设定好你要的字体，并置为当前字体。。。

设置了当前 但是好像没用