闭合多义线面积批量标注

5cllovely

lz发的插件不能使用，请核对再上传，谢谢，我用的12cad

香田里浪人

5cllovely 发表于 2013-9-17 12:47
lz发的插件不能使用，请核对再上传，谢谢，我用的12cad

看14楼，试一下，如何？

zbwei120

删除“ (mkla "面积注释" 1);;;此句可以显示面积标注颜色，1红色2黄色3绿色”即可使用，因该句mkla未定义，所以删除后即可使用，人家能发出来已很不错了，别说怪罪别人的话。

lzg8877

一上來就有好東東收藏了

5cllovely

香田里浪人 发表于 2013-9-17 13:45
看14楼，试一下，如何？

在08,12cad都测试了，不能使用，加载后运行，就提示未知命令，是不是lz还定义了其他外部函数

香田里浪人

5cllovely 发表于 2013-9-18 16:50
在08,12cad都测试了，不能使用，加载后运行，就提示未知命令，是不是lz还定义了其他外部函数

我只装04，在04是可以用，其他版本我没有试，不知道。

newbuser

经测试，第一个程序如果有弧形多段线，面积标注错误。

newbuser

这个鸟程序可以框选批量标注面积，字体打下随面积改变的。但不支持圆和非闭合多段线

1. (defun c:mj ( / ee h i slst ss vlalst x xy)
   
2. (setq ss (ssget '((0 . "LWPOLYLINE"))))
   
3. (setq slst (ss-en ss))
   
4. (setq slst
   
5.    (vl-remove-if
   
6.      'not
   
7.      (mapcar
   
8.        '(lambda (x)
   
9.     (if
   
10.       (= (vlax-curve-isClosed (vlax-ename->vla-object x)) T) ;;判断为闭合的图元名组表
    
11.        x
    
12.     )
    
13.         )
    
14.        slst
    
15.      )
    
16.    )
    
17.   )
    
18. (setq vlalst (mapcar 'vla-get-Area (mapcar 'vlax-ename->vla-object slst)))
    
19.   (setq i 0)
    
20.   (repeat (length slst)
    
21.     (bwh (nth i slst))
    
22.     (setq ee (emake (nth i vlalst) xy h))
    
23. ;;;    (entmod ee)
    
24.     (setq i (1+ i))
    
25.   )
    
26.   (princ)
    
27. )
    
28. 
    
29. 
    
30. ;选择集变图元名表
    
31. (defun ss-en (ss / a en lst)
    
32.     (setq a -1)
    
33.     (while (setq en (ssname ss (setq a (1+ a))
    
34.             )
    
35.         )
    
36.         (setq lst (cons en lst))
    
37.     )
    
38.     lst
    
39. )
    
40. 
    
41. ;;包围盒中点坐标(获取字体高度，文字插入点坐标)
    
42. (defun bwh (e / ll ur p2 p4)
    
43.   (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
    
44.   (setq  ll (mapcar 'vlax-safearray->list (list ll ur))
    
45.   )
    
46.   (setq  h
    
47.    (* (sqrt
    
48.         (apply '+
    
49.          (list (expt (apply '- (list (caar ll) (caadr ll))) 2)
    
50.          (expt (apply '- (list (cadar ll) (cadadr ll))) 2)
    
51.          )
    
52.         )
    
53.       )
    
54.       0.04
    
55.    )
    
56.   )
    
57.   (setq x (* (apply '+ (list (caar ll) (caadr ll))) 0.5))
    
58.   (setq y (* (apply '+ (list (cadar ll) (cadadr ll))) 0.5))
    
59.   (setq xy (list x y))
    
60. )
    
61. 
    
62. ;;;建立文本函数
    
63. 
    
64. (defun emake (mj xy h)
    
65.   (command "-text" "j" "mc" xy h 0 (rtos mj 2 3)))

(defun c:mj ( / ee h i slst ss vlalst x xy)<br /> (setq ss (ssget '((0 . "LWPOLYLINE"))))<br /> (setq slst (ss-en ss))<br /> (setq slst<br />    (vl-remove-if<br />      'not<br />      (mapcar<br />        '(lambda (x)<br />     (if<br />       (= (vlax-curve-isClosed (vlax-ename->vla-object x)) T) ;;判断为闭合的图元名组表<br />        x<br />     )<br />         )<br />        slst<br />      )<br />    )<br />   )<br /> (setq vlalst (mapcar 'vla-get-Area (mapcar 'vlax-ename->vla-object slst)))<br />   (setq i 0)<br />   (repeat (length slst)<br />     (bwh (nth i slst))<br />     (setq ee (emake (nth i vlalst) xy h))<br /> ;;;    (entmod ee)<br />     (setq i (1+ i))<br />   )<br />   (princ)<br /> )<br /> <br /> <br /> ;选择集变图元名表 <br /> (defun ss-en (ss / a en lst)<br />     (setq a -1)<br />     (while (setq en (ssname ss (setq a (1+ a))<br />             )<br />         )<br />         (setq lst (cons en lst))<br />     )<br />     lst<br /> )<br /> <br /> ;;包围盒中点坐标(获取字体高度，文字插入点坐标)<br /> (defun bwh (e / ll ur p2 p4)<br />   (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)<br />   (setq  ll (mapcar 'vlax-safearray->list (list ll ur))<br />   )<br />   (setq  h<br />    (* (sqrt<br />         (apply '+<br />          (list (expt (apply '- (list (caar ll) (caadr ll))) 2)<br />          (expt (apply '- (list (cadar ll) (cadadr ll))) 2)<br />          )<br />         )<br />       )<br />       0.04<br />    )<br />   )<br />   (setq x (* (apply '+ (list (caar ll) (caadr ll))) 0.5))<br />   (setq y (* (apply '+ (list (cadar ll) (cadadr ll))) 0.5))<br />   (setq xy (list x y))<br /> )<br /> <br /> ;;;建立文本函数<br /> <br /> (defun emake (mj xy h)<br />   (command "-text" "j" "mc" xy h 0 (rtos mj 2 3)))

品茗新秀

这个程序需加改进，如开口为多大，程序如何处理，如何生成一一对应的表格在CAD中。并将数据填在表格中。

CAD小学徒

能否批量只标记面积且批量导到excel中