求助能否把N条直线的长度按图纸比例写在各直线上方，谢谢！

cxs259

求助能否把N条直线的长度按图纸比例写在各直线上方，谢谢！

x_s_s_1

版主的程序如果再考虑文字角度与线平行就完满了

cxs259

搜索本论坛后，找到有个相似的，只能显示但不能写入，请求各位大侠能否给修改一下，谢谢！
(defun c:tl()
(setq tleng 0)
(setq s (ssget))
(setq n (sslength s))
(setq index (- n 1))
(repeat n
(vl-load-com)
(setq ent (ssname s index))
(setq index (- index 1))
(setq curve-obj (vlax-ename->vla-object ent))
(setq leng (vlax-curve-getDistAtParam
curve-obj
(vlax-curve-getEndParam curve-obj)
)
)
(setq tleng (+ tleng leng))
(princ leng)
(princ "\n")
)
(setq prscreemtext (strcat "\n总共计算" (itoa n) "个对象，总长度为 " (rtos tleng 2 3)))
(princ prscreemtext)
(princ)
)

Gu_xl

2. 
   
3. (defun c:tt(/ ss i k scale en dist dist1 dist2 pt pt0 pt1 ang)
   
4.   (initget 1)
   
5.   (setq scale (getreal "\n比例尺 1:"))
   
6.   (initget 1)
   
7.   (setq h (getreal "\n字高:"))
   
8.   
   
9.   (setq ss (ssget '((0 . "*polyline"))))
   
10.   (if ss
    
11.     (progn
    
12.       (setq i 0)
    
13.       (repeat (sslength ss)
    
14.       (setq en (ssname ss i)
    
15.             k 1
    
16.             dist0 0
    
17.             PT0 (vlax-curve-getStartPoint EN ))
    
18.         (repeat (fix (vlax-curve-getEndParam en))
    
19.           (setq dist1 (vlax-curve-getDistAtParam en k)
    
20.                 PT1 (vlax-curve-getPointAtParam EN k)
    
21.                 ANG (ANGLE PT0 PT1)
    
22.                 dist (- dist1 dist0)
    
23.                 dist (/ dist scale)
    
24.                 dist0 dist1
    
25.                 PT0 PT1
    
26.                 PT (POLAR (vlax-curve-getPointAtParam EN (- k 0.5)) (+ ANG (/ PI 2)) (* 2 H))
    
27.                 )
    
28.           (entmake (list '(0 . "text") (cons 1 (rtos dist 2 0)) (cons 10 pt) (cons 40 h)))
    
29.           (setq k (1+ k))
    
30.           )
    
31.         (setq i (1+ i))
    
32.         )
    
33.       
    
34.       )
    
35.     )
    
36.   )
    

<br /> (defun c:tt(/ ss i k scale en dist dist1 dist2 pt pt0 pt1 ang)<br />   (initget 1)<br />   (setq scale (getreal "\n比例尺 1:"))<br />   (initget 1)<br />   (setq h (getreal "\n字高:"))<br />   <br />   (setq ss (ssget '((0 . "*polyline"))))<br />   (if ss<br />     (progn<br />       (setq i 0)<br />       (repeat (sslength ss)<br />       (setq en (ssname ss i)<br />             k 1<br />             dist0 0<br />             PT0 (vlax-curve-getStartPoint EN ))<br />         (repeat (fix (vlax-curve-getEndParam en))<br />           (setq dist1 (vlax-curve-getDistAtParam en k)<br />                 PT1 (vlax-curve-getPointAtParam EN k)<br />                 ANG (ANGLE PT0 PT1)<br />                 dist (- dist1 dist0)<br />                 dist (/ dist scale)<br />                 dist0 dist1<br />                 PT0 PT1<br />                 PT (POLAR (vlax-curve-getPointAtParam EN (- k 0.5)) (+ ANG (/ PI 2)) (* 2 H))<br />                 )<br />           (entmake (list '(0 . "text") (cons 1 (rtos dist 2 0)) (cons 10 pt) (cons 40 h)))<br />           (setq k (1+ k))<br />           )<br />         (setq i (1+ i))<br />         )<br />       <br />       )<br />     )<br />   )<br />

ljttjl

线段标注边长程序
注意：在使用时，可根椐需要设置当前标注样式即可。如此贴中可将标注样式中尺寸线、界线去掉后即可达到要求。

以下为此程序演示：

duotu007

版主的程序很好，描图时很有用。
(entmake (list '(0 . "text") (cons 1 (rtos dist 2 0)) (cons 10 pt) (cons 40 h)))
改成
(entmake (list '(0 . "text") (cons 1 (rtos dist 2 2)) (cons 10 pt) (cons 40 h)))
就可以显示小数了。

仲文玉

支持程序优化，支持源码

cxs259

感谢Gu_xl 版主，但是出来的数字有点乱，见附图，能否调整？

cxs259

如果把"LINE" "直线"，("ARC" "圆弧")，("CIRCLE" "圆")，("LWPOLYLINE" "多段线")，("ELLIPSE" "椭圆")，("SPLINE" "样条线")都能写入，那就更完美了