[编程申请]：麻烦大家帮我看看这个程序

hao3ren

麻烦大家帮我看看这个程序


(defun c:75 (/)
(setvar "cmdecho" 1)
(setq a1 (getpoint "\n第一点")
a2 (getpoint "\n第二点")
ang (* (/ (angle a1 a2) pi) 180)
dist (rtos (/ (distance a1 a2) 1) 2 0)
dist1 (strcat "de75"  ","dist "m" )
a3 (getpoint "文字插入点")
)
(command "text" a3 "7" ang dist1)
(while (not (SETQ ss (ssget (LIST (cons 0 "text"))))))
  (setq        n  -1
        s1 (ssname ss 0)
  )
(princ (xyp-get-DXF 41 s1))
  (setq th (UREAL 1 "" "新宽度因子为" 0.75))
  (while (setq s1 (ssname ss (setq n (1+ n))))
    (princ ".")
    (xyp-SubUpd s1 41 th)
  )   
(princ)
)
需要定义字体的宽度，不过，上面这个勉强可以用，不好用，每次都要选择
还有文字的位置能否直接放在所选择的两个点的中间，文字采用中对齐，文字距离直线需留出来一定距离
如果可以直接选择线段直接标注需要的东西应该怎么做啊
以上程序是根据大家的程序拼出来的，希望不会冒犯各位高手

Free-Lancer

2. 
   
3. (vl-load-com)
   
4. (defun c:75 (/ p1 p2 midp txt ms)
   
5.   (setvar "cmdecho" 1)
   
6.   (setq        ms (vla-get-modelspace
   
7.              (vla-get-activedocument (vlax-get-acad-object))
   
8.            )
   
9.   )
   
10.   (while (and (setq p1 (getpoint "\n第一点"))
    
11.               (setq p2 (getpoint p1 "\n第二点"))
    
12.          )
    
13.     (setq midp (vlax-3d-point
    
14.                  (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)
    
15.                )
    
16.           txt  (vla-addtext
    
17.                  ms
    
18.                  (strcat "de75"
    
19.                          ","
    
20.                          (rtos (distance p1 p2) 2 0)
    
21.                          "m"
    
22.                  )
    
23.                  midp
    
24.                  7.
    
25.                )
    
26.     )
    
27.     (vla-put-alignment txt acAlignmentBottomCenter)
    
28.     (vla-put-TextAlignmentPoint txt midp)
    
29.     (vla-put-scalefactor txt 0.75)
    
30.     (vla-put-rotation txt (angle p1 p2))
    
31.   )
    
32.   (vlax-release-object ms)
    
33.   (princ)
    
34. )

<br /> (vl-load-com)<br /> (defun c:75 (/ p1 p2 midp txt ms)<br />   (setvar "cmdecho" 1)<br />   (setq        ms (vla-get-modelspace<br />              (vla-get-activedocument (vlax-get-acad-object))<br />            )<br />   )<br />   (while (and (setq p1 (getpoint "\n第一点"))<br />               (setq p2 (getpoint p1 "\n第二点"))<br />          )<br />     (setq midp (vlax-3d-point<br />                  (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)<br />                )<br />           txt  (vla-addtext<br />                  ms<br />                  (strcat "de75"<br />                          ","<br />                          (rtos (distance p1 p2) 2 0)<br />                          "m"<br />                  )<br />                  midp<br />                  7.<br />                )<br />     )<br />     (vla-put-alignment txt acAlignmentBottomCenter)<br />     (vla-put-TextAlignmentPoint txt midp)<br />     (vla-put-scalefactor txt 0.75)<br />     (vla-put-rotation txt (angle p1 p2))<br />   )<br />   (vlax-release-object ms)<br />   (princ)<br /> )

hao3ren

谢谢，很好用，那能不能写一个选择线段直接标注的，就是不用选择两点了，不知能否批量处理，就是选择所有线段全部标注上文字，我有大量的这样的工作，恳请高手帮忙

金鹅起飞

谢谢楼主分享，支持源码！