[求助]直线上的文字自动居中,并且与直线有指定的间隔

xaove

大虾们,如题,帮帮忙!

用到的地方,比如梁的编号与梁线

mccad

用标注，改标注样式，不用箭头、不用界线、不用标注线，就OK了。不用编程

lifefun

我也需要这个功能的代码

编程小白

“mccad”  的方法问题是怎样有与直线固定的间隙呢

阿然

写了一个，感觉不完善
用了grread，距离就不知道怎么用键盘输入
期待高人完善

1. (vl-load-com)
   
2. (setvar "cmdecho" 0)
   
3. (setq *AcadDoc* (vla-get-ActiveDocument (vlax-get-Acad-Object)))
   
4. (setq *MoSpace* (vla-get-ModelSpace *AcadDoc*))
   
5. 
   
6. (defun c:tt (/ ent stpt enpt midpt lineang txt grpt pt templine)
   
7.   (if (not *txth*)
   
8.     (setq *txth* (cond ((getreal "\n输入标注文字高度:"))
   
9.            (2.0)
   
10.      )
    
11.     )
    
12.   )
    
13.   (if (and (setq ent (car (entsel "\n选择直线:")))
    
14.      (setq elst (entget ent))
    
15.      (equal (cdr (assoc 0 elst)) "LINE")
    
16.       )
    
17.     (progn
    
18.       (if (setq txt (getstring "\n输入标注文字:"))
    
19.   (progn
    
20.     (setq  stpt  (cdr (assoc 10 elst))
    
21.     enpt  (cdr (assoc 11 elst))
    
22.     midpt  (mapcar '(lambda (x y) (/ (+ x y) 2.)) stpt enpt)
    
23.     lineang  (angle stpt enpt)
    
24.     )
    
25.     (setq grpt (cadr (grread 5)))
    
26.     (setq
    
27.       grdist (distance (vlax-curve-getclosestpointto ent grpt)
    
28.            grpt
    
29.        )
    
30.     )
    
31.     (if (LM:Clockwise-p stpt enpt grpt)
    
32.       (setq temppt (polar midpt (- lineang (* pi 0.5)) grdist)
    
33.       txtang (+ lineang pi)
    
34.       )
    
35.       (setq temppt (polar midpt (+ lineang (* pi 0.5)) grdist)
    
36.       txtang lineang
    
37.       )
    
38.     )
    
39.     (setq txtobj (Xr:drawtext txt temppt *txth*))
    
40.     (vla-put-rotation txtobj txtang)
    
41.     (prompt "\n选择方向和距离:")
    
42.     (while (and (setq gr (grread 5))
    
43.           (= (car gr) 5)
    
44.      )
    
45.       (setq grpt (cadr gr))
    
46.       (setq
    
47.         grdist (distance (vlax-curve-getclosestpointto ent grpt)
    
48.              grpt
    
49.          )
    
50.       )
    
51.       (if  (LM:Clockwise-p stpt enpt grpt)
    
52.         (setq temppt (polar midpt (- lineang (* pi 0.5)) grdist)
    
53.         txtang (+ lineang pi)
    
54.         )
    
55.         (setq temppt (polar midpt (+ lineang (* pi 0.5)) grdist)
    
56.         txtang lineang
    
57.         )
    
58.       )
    
59.       (vlax-put-property
    
60.         txtobj
    
61.         'TextAlignmentPoint
    
62.         (vlax-3d-point temppt)
    
63.       )
    
64.       (vla-put-rotation txtobj txtang)
    
65.       (redraw)
    
66.     ) ;_  while
    
67.   )
    
68.       )
    
69.     )
    
70.     (progn
    
71.       (princ "\n选择的不是直线或者取消选择")
    
72.       (princ)
    
73.     )
    
74.   )
    
75. )
    
76. 
    
77. (defun LM:Clockwise-p (p1 p2 p3)
    
78.   ((lambda (n) (< (car (trans p2 0 n)) (car (trans p1 0 n))))
    
79.     (mapcar '- p1 p3)
    
80.   )
    
81. )
    
82. 
    
83. 
    
84. ;;;绘制文字
    
85. (defun Xr:Drawtext (txtstring txtpt txtheight / otext textpt)
    
86.   (setq textpt (vlax-3d-point txtpt))
    
87.   (setq
    
88.     otext (vla-addtext *MoSpace* txtstring textpt txtheight)
    
89.   )
    
90.   (vlax-put-property otext 'Alignment 10)
    
91.   (vlax-put-property otext 'TextAlignmentPoint textpt)
    
92.   otext
    
93. )
    
94. 
    

(vl-load-com)<br /> (setvar "cmdecho" 0)<br /> (setq *AcadDoc* (vla-get-ActiveDocument (vlax-get-Acad-Object)))<br /> (setq *MoSpace* (vla-get-ModelSpace *AcadDoc*))<br /> <br /> (defun c:tt (/ ent stpt enpt midpt lineang txt grpt pt templine)<br />   (if (not *txth*)<br />     (setq *txth* (cond ((getreal "\n输入标注文字高度:"))<br />            (2.0)<br />      )<br />     )<br />   )<br />   (if (and (setq ent (car (entsel "\n选择直线:")))<br />      (setq elst (entget ent))<br />      (equal (cdr (assoc 0 elst)) "LINE")<br />       )<br />     (progn<br />       (if (setq txt (getstring "\n输入标注文字:"))<br />   (progn<br />     (setq  stpt  (cdr (assoc 10 elst))<br />     enpt  (cdr (assoc 11 elst))<br />     midpt  (mapcar '(lambda (x y) (/ (+ x y) 2.)) stpt enpt)<br />     lineang  (angle stpt enpt)<br />     )<br />     (setq grpt (cadr (grread 5)))<br />     (setq<br />       grdist (distance (vlax-curve-getclosestpointto ent grpt)<br />            grpt<br />        )<br />     )<br />     (if (LM:Clockwise-p stpt enpt grpt)<br />       (setq temppt (polar midpt (- lineang (* pi 0.5)) grdist)<br />       txtang (+ lineang pi)<br />       )<br />       (setq temppt (polar midpt (+ lineang (* pi 0.5)) grdist)<br />       txtang lineang<br />       )<br />     )<br />     (setq txtobj (Xr:drawtext txt temppt *txth*))<br />     (vla-put-rotation txtobj txtang)<br />     (prompt "\n选择方向和距离:")<br />     (while (and (setq gr (grread 5))<br />           (= (car gr) 5)<br />      )<br />       (setq grpt (cadr gr))<br />       (setq<br />         grdist (distance (vlax-curve-getclosestpointto ent grpt)<br />              grpt<br />          )<br />       )<br />       (if  (LM:Clockwise-p stpt enpt grpt)<br />         (setq temppt (polar midpt (- lineang (* pi 0.5)) grdist)<br />         txtang (+ lineang pi)<br />         )<br />         (setq temppt (polar midpt (+ lineang (* pi 0.5)) grdist)<br />         txtang lineang<br />         )<br />       )<br />       (vlax-put-property<br />         txtobj<br />         'TextAlignmentPoint<br />         (vlax-3d-point temppt)<br />       )<br />       (vla-put-rotation txtobj txtang)<br />       (redraw)<br />     ) ;_  while<br />   )<br />       )<br />     )<br />     (progn<br />       (princ "\n选择的不是直线或者取消选择")<br />       (princ)<br />     )<br />   )<br /> )<br /> <br /> (defun LM:Clockwise-p (p1 p2 p3)<br />   ((lambda (n) (< (car (trans p2 0 n)) (car (trans p1 0 n))))<br />     (mapcar '- p1 p3)<br />   )<br /> )<br /> <br /> <br /> ;;;绘制文字<br /> (defun Xr:Drawtext (txtstring txtpt txtheight / otext textpt)<br />   (setq textpt (vlax-3d-point txtpt))<br />   (setq<br />     otext (vla-addtext *MoSpace* txtstring textpt txtheight)<br />   )<br />   (vlax-put-property otext 'Alignment 10)<br />   (vlax-put-property otext 'TextAlignmentPoint textpt)<br />   otext<br /> )<br /> <br />