标注线段长度【文字方式】

仲文玉

2. 
   
3. (defun C:kxbz ()
   
4.   (COMMAND "UCS" "")
   
5.   (setq cmdecho_bak (getvar "cmdecho"))
   
6.   (setq AcadObject   (vlax-get-acad-object)
   
7. AcadDocument (vla-get-ActiveDocument Acadobject)
   
8. mSpace      (vla-get-ModelSpace Acaddocument)
   
9.   )
   
10.   ;;选取需要测量的样条曲线、圆弧、直线、椭圆
    
11.   (setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
    
12.   (setq i 0)
    
13.   ;;获取系统参数textsize
    
14.   (setq shh (getvar "textsize"))
    
15.   (setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: "))
    
16.   (setq hh (getdist str_hh))
    
17.   (while hh
    
18.     (setvar "textsize" hh)
    
19.     (setq hh nil)
    
20.   )
    
21.   ;;输入标注文字高度
    
22.   ;;循环开始
    
23.   (repeat (sslength en)
    
24.     (setq ss (ssname en i))
    
25.     (setq endata (entget ss))
    
26.     (command "lengthen" ss "")
    
27.     (setq dd (getvar "perimeter"))
    
28.     (princ (strcat "\n长度=" (rtos dd 2)))
    
29.     ;;寻找代表图层的字符串
    
30.     (setq aa (assoc 0 endata))
    
31.     ;;获取图层名称
    
32.     (setq aa1 (cdr aa))
    
33.     ;;判断线条种类
    
34.     (cond
    
35.       ((= aa1 "SPLINE")
    
36.        ;;如果是spline
    
37.        (progn
    
38.   (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
    
39.   (setq startPnt1 (vla-get-ControlPoints arcObj))
    
40.   (setq p1
    
41.   (vlax-safearray->list (vlax-variant-value startPnt1))
    
42.   )
    
43.   (setq x1 (car p1))
    
44.   (setq y1 (cadr p1))
    
45.   (setq z1 (caddr p1))
    
46.   (setq pp1 (list x1 y1 z1))
    
47.   (repeat (- (/ (length p1) 3) 1)
    
48.     ;;循环，寻找最后一个控制点
    
49.     (setq p1 (cdddr p1))
    
50.     (setq x2 (car p1))
    
51.     (setq y2 (cadr p1))
    
52.     (setq z2 (caddr p1))
    
53.   )
    
54.   (setq pp2 (list x2 y2 z2))
    
55.        )
    
56.       )
    
57.       ((= aa1 "LWPOLYLINE")
    
58.        ;;如果是LWPOLYLINE
    
59.        (progn
    
60.   (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
    
61.   (setq startPnt1 (vla-get-Coordinates arcObj))
    
62.   (setq p1 (vlax-safearray->list (vlax-variant-value startPnt1)))
    
63.   (setq x1 (car p1))
    
64.   (setq y1 (cadr p1))
    
65.   (setq z1 (caddr p1))
    
66.   (setq pp1 (list x1 y1 z1))
    
67.   (repeat (- (/ (length p1) 3) 1)
    
68.     ;;循环，寻找最后一个控制点
    
69.     (setq p1 (cdddr p1))
    
70.     (setq x2 (car p1))
    
71.     (setq y2 (cadr p1))
    
72.     (setq z2 (caddr p1))
    
73.   )
    
74.   (setq pp2 (list x2 y2 z2))
    
75.        )
    
76.       )
    
77.       (t
    
78.        (princ)
    
79.        ;;如果是其他种类线条
    
80.        (progn
    
81.   (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
    
82.   (setq startPnt1 (vla-get-StartPoint arcObj))
    
83.   ;;获取起点
    
84.   (setq endPnt1 (vla-get-EndPoint arcObj))
    
85.   ;;获取终点
    
86.   (setq pp1
    
87.   (vlax-safearray->list (vlax-variant-value startPnt1))
    
88.   )
    
89.   (setq
    
90.     pp2 (vlax-safearray->list (vlax-variant-value endPnt1))
    
91.   )
    
92.        )
    
93.       )
    
94.     )
    
95.     (setq x1 (car pp1))
    
96.     (setq y1 (cadr pp1))
    
97.     (setq z1 (caddr pp1))
    
98.     (setq x2 (car pp2))
    
99.     (setq y2 (cadr pp2))
    
100.     (setq z2 (caddr pp2))
     
101.     (setq x (/ (+ x1 x2) 2))
     
102.     (setq y (/ (+ y1 y2) 2))
     
103.     (setq z (/ (+ z1 z2) 2))
     
104.     (setq pt (list x y z))
     
105.     ;;取得线段两端的中点
     
106.     (setq ang (angle pp1 pp2))
     
107.     ;;获取角度
     
108.     (if (> (* (/ ang pi) 180) 180)
     
109.       (setq ang (+ ang pi))
     
110.     )
     
111.     (command "text"
     
112.       "j"
     
113.       "bc"
     
114.       pt
     
115.       ""
     
116.       (* (/ ang pi) 180)
     
117.       (strcat "" (rtos dd 2))
     
118.     )
     
119.     (princ)
     
120.     (setq i (1+ i))
     
121.   )
     
122.   (princ)
     
123.   (setvar "cmdecho" cmdecho_bak)
     
124.   (princ)
     
125. )

<br /> (defun C:kxbz ()<br />   (COMMAND "UCS" "")<br />   (setq cmdecho_bak (getvar "cmdecho"))<br />   (setq AcadObject   (vlax-get-acad-object)<br /> AcadDocument (vla-get-ActiveDocument Acadobject)<br /> mSpace      (vla-get-ModelSpace Acaddocument)<br />   )<br />   ;;选取需要测量的样条曲线、圆弧、直线、椭圆<br />   (setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))<br />   (setq i 0)<br />   ;;获取系统参数textsize<br />   (setq shh (getvar "textsize"))<br />   (setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: "))<br />   (setq hh (getdist str_hh))<br />   (while hh<br />     (setvar "textsize" hh)<br />     (setq hh nil)<br />   )<br />   ;;输入标注文字高度<br />   ;;循环开始<br />   (repeat (sslength en)<br />     (setq ss (ssname en i))<br />     (setq endata (entget ss))<br />     (command "lengthen" ss "")<br />     (setq dd (getvar "perimeter"))<br />     (princ (strcat "\n长度=" (rtos dd 2)))<br />     ;;寻找代表图层的字符串<br />     (setq aa (assoc 0 endata))<br />     ;;获取图层名称<br />     (setq aa1 (cdr aa))<br />     ;;判断线条种类<br />     (cond<br />       ((= aa1 "SPLINE")<br />        ;;如果是spline<br />        (progn<br />   (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))<br />   (setq startPnt1 (vla-get-ControlPoints arcObj))<br />   (setq p1<br />   (vlax-safearray->list (vlax-variant-value startPnt1))<br />   )<br />   (setq x1 (car p1))<br />   (setq y1 (cadr p1))<br />   (setq z1 (caddr p1))<br />   (setq pp1 (list x1 y1 z1))<br />   (repeat (- (/ (length p1) 3) 1)<br />     ;;循环，寻找最后一个控制点<br />     (setq p1 (cdddr p1))<br />     (setq x2 (car p1))<br />     (setq y2 (cadr p1))<br />     (setq z2 (caddr p1))<br />   )<br />   (setq pp2 (list x2 y2 z2))<br />        )<br />       )<br />       ((= aa1 "LWPOLYLINE")<br />        ;;如果是LWPOLYLINE<br />        (progn<br />   (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))<br />   (setq startPnt1 (vla-get-Coordinates arcObj))<br />   (setq p1 (vlax-safearray->list (vlax-variant-value startPnt1)))<br />   (setq x1 (car p1))<br />   (setq y1 (cadr p1))<br />   (setq z1 (caddr p1))<br />   (setq pp1 (list x1 y1 z1))<br />   (repeat (- (/ (length p1) 3) 1)<br />     ;;循环，寻找最后一个控制点<br />     (setq p1 (cdddr p1))<br />     (setq x2 (car p1))<br />     (setq y2 (cadr p1))<br />     (setq z2 (caddr p1))<br />   )<br />   (setq pp2 (list x2 y2 z2))<br />        )<br />       )<br />       (t<br />        (princ)<br />        ;;如果是其他种类线条<br />        (progn<br />   (setq arcObj (VLAX-ENAME->VLA-OBJECT ss))<br />   (setq startPnt1 (vla-get-StartPoint arcObj))<br />   ;;获取起点<br />   (setq endPnt1 (vla-get-EndPoint arcObj))<br />   ;;获取终点<br />   (setq pp1<br />   (vlax-safearray->list (vlax-variant-value startPnt1))<br />   )<br />   (setq<br />     pp2 (vlax-safearray->list (vlax-variant-value endPnt1))<br />   )<br />        )<br />       )<br />     )<br />     (setq x1 (car pp1))<br />     (setq y1 (cadr pp1))<br />     (setq z1 (caddr pp1))<br />     (setq x2 (car pp2))<br />     (setq y2 (cadr pp2))<br />     (setq z2 (caddr pp2))<br />     (setq x (/ (+ x1 x2) 2))<br />     (setq y (/ (+ y1 y2) 2))<br />     (setq z (/ (+ z1 z2) 2))<br />     (setq pt (list x y z))<br />     ;;取得线段两端的中点<br />     (setq ang (angle pp1 pp2))<br />     ;;获取角度<br />     (if (> (* (/ ang pi) 180) 180)<br />       (setq ang (+ ang pi))<br />     )<br />     (command "text"<br />       "j"<br />       "bc"<br />       pt<br />       ""<br />       (* (/ ang pi) 180)<br />       (strcat "" (rtos dd 2))<br />     )<br />     (princ)<br />     (setq i (1+ i))<br />   )<br />   (princ)<br />   (setvar "cmdecho" cmdecho_bak)<br />   (princ)<br /> )

lxl217114

香田里浪人 发表于 2014-12-6 17:51
;;;多义线边长标注
(defun HH:Remove (en / NEWDATA)
  (foreach e (entget en)

Auto CAD 2020 正常使用，但是会乱码

ccc230

我是win10 64位  CAD2010 错误: 输入的字符串有缺陷，班主咋搞呢

zfsaaa

有无让标注文字别跑那么远的修改编码？

仲文玉

忘了备注作者信息，代码版权归原作者所有；鉴于很多会员们需要，贴出来，见谅

haoryh

老大这个利害！多谢了！

GamIng

多谢版主！好东西，收藏了！

xyp1964

preone

这个 必须顶~~

461045462

谢谢斑竹的分享！
收藏了。
谢谢！

xsso

为什么我试用的时候，除了椭圆，其它的标设都乱飞到一边去

xsso

而且程序头部少了(vl-load-com)，建议补充或者加上

bai2000

标注乱发，楼主调整一下