我也会坐标标注

/db_自贡黄明儒_

我一直用NetBee版主的坐标标注，两三年用一回
以下是我刚写的，虽然不怎么好看，但也可以将就用

1. ;;坐标标注(全局*Ang_ZBBZ*)
   
2. (defun C:zbbz (/ ANS FLAG P1 P2 STR TEXTHEIGHT zbbz1 zbbz2)
   
3.   (defun zbbz1 ()
   
4.     (initget "S ")
   
5.     (princ "\n 坐标点, or [输入角度S] <S>:")
   
6.     (setq p1 (getpoint));(setq p1 (getpoint "\n坐标点"))
   
7.   )
   
8.   (defun zbbz2 ()
   
9.     (setq AnS (zbbz1))
   
10.     (cond
    
11.       ((= AnS "S") (setq *Ang_ZBBZ* (getangle "\n文字倾角")) (zbbz2))
    
12.       ((= (type AnS) 'List)
    
13.        (cond
    
14.          ((setq p2 (getpoint AnS "\n放置"))
    
15.           (setq        str (strcat "X="
    
16.                             (VL-PRINC-TO-STRING (cadr p1))
    
17.                             "\\P"
    
18.                             "Y="
    
19.                             (VL-PRINC-TO-STRING (car p1))                           
    
20.                     )
    
21.           )
    
22.           (_AddLeader AnS p2 str *Ang_ZBBZ* TextHeight)
    
23.          )
    
24.          (T (setq Flag nil))
    
25.        )
    
26.       )
    
27.       (T (setq Flag nil))
    
28.     )
    
29.   )
    
30. 
    
31.   (vl-Load-COM)
    
32.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
    
33.   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
    
34.   (or *MS* (setq *MS* (vla-get-modelSpace *DOC*)))
    
35. 
    
36.   (cond((not *Ang_ZBBZ*)(setq *Ang_ZBBZ* 0)))
    
37.   (SETQ TextHeight (* (GETVAR "DIMTXT") (GETVAR "DIMSCALE"))) ;字高
    
38.   (setq Flag T)
    
39.   (while Flag (zbbz2))
    
40.   (princ)
    
41. )
    
42. 
    
43. 
    
44. (defun _AddLeader (p1 p2 str Ang TextHeight / HANDLEM OBJL OBJM POINTS)
    
45.   (setq points (vlax-make-safearray vlax-vbDouble '(0 . 5)))
    
46.   (vlax-safearray-fill points (append P1 p2))
    
47.   ;;(vla-AddMText modelSpace corner width text)
    
48.   (setq ObjM (vla-AddMText *MS* (vlax-3d-point p2) 1 str))
    
49.   ;;Height AttachmentPoint Handle Width
    
50.   (vlax-put ObjM 'Height TextHeight);05版用vla-put-TextHeight不灵
    
51.   (vlax-put ObjM 'AttachmentPoint 7);左下角
    
52.   (vlax-put ObjM 'Width 0);没有框，只有左下角一个夹点
    
53.   ;;BackgroundFill 05版及以上16.1
    
54.   (cond ((> (atof (getvar "ACADVER")) 16) (vlax-put ObjM 'BackgroundFill 1)))
    
55.   (vlax-put ObjM 'Rotation Ang)
    
56.   (setq ObjL (vla-AddLeader *MS* points ObjM acLineNoArrow))
    
57.   (setq HandleM (vlax-get ObjM 'Handle))
    
58. )
    
59. 
    

;;坐标标注(全局*Ang_ZBBZ*)<br /> (defun C:zbbz (/ ANS FLAG P1 P2 STR TEXTHEIGHT zbbz1 zbbz2)<br />   (defun zbbz1 ()<br />     (initget "S ")<br />     (princ "\n 坐标点, or [输入角度S] <S>:")<br />     (setq p1 (getpoint));(setq p1 (getpoint "\n坐标点"))<br />   )<br />   (defun zbbz2 ()<br />     (setq AnS (zbbz1))<br />     (cond<br />       ((= AnS "S") (setq *Ang_ZBBZ* (getangle "\n文字倾角")) (zbbz2))<br />       ((= (type AnS) 'List)<br />        (cond<br />          ((setq p2 (getpoint AnS "\n放置"))<br />           (setq        str (strcat "X="<br />                             (VL-PRINC-TO-STRING (cadr p1))<br />                             "\\P"<br />                             "Y="<br />                             (VL-PRINC-TO-STRING (car p1))                            <br />                     )<br />           )<br />           (_AddLeader AnS p2 str *Ang_ZBBZ* TextHeight)<br />          )<br />          (T (setq Flag nil))<br />        )<br />       )<br />       (T (setq Flag nil))<br />     )<br />   )<br /> <br />   (vl-Load-COM)<br />   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))<br />   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))<br />   (or *MS* (setq *MS* (vla-get-modelSpace *DOC*)))<br /> <br />   (cond((not *Ang_ZBBZ*)(setq *Ang_ZBBZ* 0)))<br />   (SETQ TextHeight (* (GETVAR "DIMTXT") (GETVAR "DIMSCALE"))) ;字高<br />   (setq Flag T)<br />   (while Flag (zbbz2))<br />   (princ)<br /> )<br /> <br /> <br /> (defun _AddLeader (p1 p2 str Ang TextHeight / HANDLEM OBJL OBJM POINTS)<br />   (setq points (vlax-make-safearray vlax-vbDouble '(0 . 5)))<br />   (vlax-safearray-fill points (append P1 p2))<br />   ;;(vla-AddMText modelSpace corner width text)<br />   (setq ObjM (vla-AddMText *MS* (vlax-3d-point p2) 1 str))<br />   ;;Height AttachmentPoint Handle Width<br />   (vlax-put ObjM 'Height TextHeight);05版用vla-put-TextHeight不灵<br />   (vlax-put ObjM 'AttachmentPoint 7);左下角<br />   (vlax-put ObjM 'Width 0);没有框，只有左下角一个夹点<br />   ;;BackgroundFill 05版及以上16.1<br />   (cond ((> (atof (getvar "ACADVER")) 16) (vlax-put ObjM 'BackgroundFill 1)))<br />   (vlax-put ObjM 'Rotation Ang)<br />   (setq ObjL (vla-AddLeader *MS* points ObjM acLineNoArrow))<br />   (setq HandleM (vlax-get ObjM 'Handle)) <br /> )<br /> <br />

lucas3

长老，你这个坐标标注可是研究了几年哟，:lol

/db_自贡黄明儒_

lucas3 发表于 2016-5-20 13:40
长老，你这个坐标标注可是研究了几年哟，

是呀，赶上NetBee版主，who can say !

q3_2006

这个很难吗...看下技巧!

发个公告日后

新人学习，谢谢！

HLCAD

看演示，还可以自动更新坐标值，不错，不错！

发个公告日后

只能标注到小数点后1位吗？怎么实现小数点后2、3位的显示？

819534890

good good.

/db_自贡黄明儒_

HLCAD 发表于 2016-5-20 15:54
看演示，还可以自动更新坐标值，不错，不错！

用了反应器，所以可以更新。这部分代码没贴出来。。

newer

/db_自贡黄明儒_ 发表于 2016-5-20 16:45
用了反应器，所以可以更新。这部分代码没贴出来。。

反应器代码很主要啊，贴出来吧，可以收点币。:P

/db_自贡黄明儒_

q3_2006 发表于 2016-5-20 15:37
这个很难吗...看下技巧!

要做好恐怕就难，这不，主张开源的NetBee版主的源码迟迟没贴出来，不过他好像说了有空要贴出来的，期待吧

/db_自贡黄明儒_

newer 发表于 2016-5-20 16:47
反应器代码很主要啊，贴出来吧，可以收点币。

不太成熟

游客，如果您要查看本帖隐藏内容请回复

newer

/db_自贡黄明儒_ 发表于 2016-5-20 16:51
不太成熟
**** 本内容被作者隐藏 ****

什么时候这样谦虚了

st788796

/db_自贡黄明儒_ 发表于 2016-5-20 16:51
不太成熟
**** 本内容被作者隐藏 ****

黄老的作品一定要支持的！

/db_自贡黄明儒_

st788796 发表于 2016-5-20 17:34
黄老的作品一定要支持的！

还是你用xd涵数写的更正宗!