【求助】请问XY坐标横线上下标注该如何修改

yangchao2005090

2. ;; (_AddMleader (getpoint) (getpoint) "A" 3.5)
   
3. (defun _AddLeader (p1 p2 str Ang TextHeight / HANDLEM OBJL OBJM POINTS)
   
4.   (setq points (vlax-make-safearray vlax-vbDouble '(0 . 5)))
   
5.   (vlax-safearray-fill points (append P1 p2))
   
6.   ;;(vla-AddMText modelSpace corner width text)
   
7.   (setq ObjM (vla-AddMText *MS* (vlax-3d-point p2) 1 str))
   
8.   ;;Height AttachmentPoint Handle Width
   
9.   (vlax-put ObjM 'Height TextHeight);05版用vla-put-TextHeight不灵
   
10.   (vlax-put ObjM 'AttachmentPoint 7);左下角
    
11.   (vlax-put ObjM 'Width 0);没有框，只有左下角一个夹点
    
12.   ;;BackgroundFill 05版及以上16.1
    
13.   (cond ((> (atof (getvar "ACADVER")) 16) (vlax-put ObjM 'BackgroundFill 1)))
    
14.   (vlax-put ObjM 'Rotation Ang)
    
15.   (setq ObjL (vla-AddLeader *MS* points ObjM acLineNoArrow))
    
16.   (setq HandleM (vlax-get ObjM 'Handle))  
    
17.   ;;(vlr-pers (VLR-Object-Reactor (list ObjL) (list HandleM) '((:VLR-modified . _LeaderModify))))
    
18.   (VLR-Object-Reactor (list ObjL) (list HandleM) '((:VLR-modified . _LeaderModify)))
    
19.   (list ObjM ObjL)
    
20. )
    
21. (defun _LeaderModify (ObjL ObjMList parameter-list / EL EM EN PTS STR)
    
22.   (setq eL (vlax-vla-object->ename ObjL))
    
23.   (setq pts (vlax-get ObjL 'Coordinates))
    
24.   (setq eM (handent (car (vlr-data ObjMList))))                    ;文本
    
25.   (setq en (entget em))
    
26.   (setq        str (strcat "X="
    
27.                      (VL-PRINC-TO-STRING (cadr pts))
    
28.                      "\\P"
    
29.                      "Y="
    
30.                      (VL-PRINC-TO-STRING (car pts))
    
31.                    )
    
32.   )
    
33.   (entmod (subst (cons 1 str) (assoc 1 en) en))
    
34. )
    
35. ;;坐标标注(全局*Ang_ZBBZ*)
    
36. (defun C:ZBBZ (/ ANS FLAG GR OBJ P1 P2 STR TEXTHEIGHT zbbz1 zbbz2)
    
37.   (defun zbbz1 ()
    
38.     (initget "S ")
    
39.     (setq p1 (getpoint "\n 坐标点, or [输入角度S] <S>:"))
    
40.   )
    
41.   (defun zbbz2 ()
    
42.     (setq AnS (zbbz1))
    
43.     (cond
    
44.       ((= AnS "S") (setq *Ang_ZBBZ* (getangle "\n文字倾角")) (zbbz2))
    
45.       ((= (type AnS) 'List)
    
46.         (princ "\n放置")
    
47.         (while (equal (setq p2 (cadr (grread T 8))) AnS TextHeight))
    
48.         (setq str (strcat "X="
    
49.                     (VL-PRINC-TO-STRING (cadr AnS))
    
50.                     "\\P"
    
51.                     "Y="
    
52.                     (VL-PRINC-TO-STRING (car AnS))
    
53.                   )
    
54.         )
    
55.         (setq Obj (_AddLeader AnS p2 str *Ang_ZBBZ* TextHeight))
    
56.         ;;(vlax-put ObjL 'Coordinates (append AnS p2))
    
57.         ;;(vlax-put ObjM 'InsertionPoint p2)
    
58.         (while (and (setq gr (grread T 8)) (= (car gr) 5))
    
59.           (setq p2 (cadr gr))         
    
60.           (cond ((not(equal p2 AnS TextHeight))
    
61.                   (vlax-put (car Obj) 'InsertionPoint p2)
    
62.                   (vlax-put (cadr Obj) 'Coordinates (append AnS p2))
    
63.                   ;;(vla-update (cadr Obj));更新不了
    
64.                 )
    
65.           )
    
66.         )
    
67.       )
    
68.       (T (setq Flag nil))
    
69.     )
    
70.   )
    
71.   (vl-Load-COM)
    
72.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
    
73.   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
    
74.   (or *MS* (setq *MS* (vla-get-modelSpace *DOC*)))
    
75.   (cond((not *Ang_ZBBZ*)(setq *Ang_ZBBZ* 0)))
    
76.   (SETQ TextHeight (* (GETVAR "DIMTXT") (GETVAR "DIMSCALE"))) ;字高
    
77.   (setq Flag T)
    
78.   (while Flag (zbbz2))
    
79.   (princ)
    
80. )

;; (_AddMleader (getpoint) (getpoint) "A" 3.5)<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 />   ;;(vlr-pers (VLR-Object-Reactor (list ObjL) (list HandleM) '((:VLR-modified . _LeaderModify))))<br />   (VLR-Object-Reactor (list ObjL) (list HandleM) '((:VLR-modified . _LeaderModify)))<br />   (list ObjM ObjL)<br /> )<br /> (defun _LeaderModify (ObjL ObjMList parameter-list / EL EM EN PTS STR)<br />   (setq eL (vlax-vla-object->ename ObjL))<br />   (setq pts (vlax-get ObjL 'Coordinates))<br />   (setq eM (handent (car (vlr-data ObjMList))))                    ;文本<br />   (setq en (entget em))<br />   (setq        str (strcat "X="<br />                      (VL-PRINC-TO-STRING (cadr pts))<br />                      "\\P"<br />                      "Y="<br />                      (VL-PRINC-TO-STRING (car pts))<br />                    )<br />   )<br />   (entmod (subst (cons 1 str) (assoc 1 en) en))<br /> )<br /> ;;坐标标注(全局*Ang_ZBBZ*)<br /> (defun C:ZBBZ (/ ANS FLAG GR OBJ P1 P2 STR TEXTHEIGHT zbbz1 zbbz2)<br />   (defun zbbz1 ()<br />     (initget "S ")<br />     (setq p1 (getpoint "\n 坐标点, or [输入角度S] <S>:"))<br />   )<br />   (defun zbbz2 ()<br />     (setq AnS (zbbz1))<br />     (cond<br />       ((= AnS "S") (setq *Ang_ZBBZ* (getangle "\n文字倾角")) (zbbz2))<br />       ((= (type AnS) 'List)<br />         (princ "\n放置")<br />         (while (equal (setq p2 (cadr (grread T 8))) AnS TextHeight))<br />         (setq str (strcat "X="<br />                     (VL-PRINC-TO-STRING (cadr AnS))<br />                     "\\P"<br />                     "Y="<br />                     (VL-PRINC-TO-STRING (car AnS))<br />                   )<br />         )<br />         (setq Obj (_AddLeader AnS p2 str *Ang_ZBBZ* TextHeight))<br />         ;;(vlax-put ObjL 'Coordinates (append AnS p2))<br />         ;;(vlax-put ObjM 'InsertionPoint p2)<br />         (while (and (setq gr (grread T 8)) (= (car gr) 5))<br />           (setq p2 (cadr gr))         <br />           (cond ((not(equal p2 AnS TextHeight))<br />                   (vlax-put (car Obj) 'InsertionPoint p2)<br />                   (vlax-put (cadr Obj) 'Coordinates (append AnS p2))<br />                   ;;(vla-update (cadr Obj));更新不了<br />                 )<br />           )<br />         )<br />       )<br />       (T (setq Flag nil))<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 />   (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 /> )

yangchao2005090

求大神帮忙修改一下