求高手赐一个批量计算面积的LISP程序

langjs

只是求程序，到交易版，还要上图纸。

路；追逐~

VBALISPER 发表于 2012-5-10 11:26
有一个标注在中心的,有一个求和的.两个都有源码,不知你到底是要求啥子

就是不仅要标注在中心，而且还显示求和，而且是要处理整个JMD图层上的封闭图形的。标注在中心和求和我都分别找到了程序，但是证明嫁接到一起去呢？？

路；追逐~

461045462 发表于 2012-5-10 11:20
要求做到的很全面，有，很理想。
请问是否做房产图所用？

嗯，房产图。。。
哥，你是知道的，要是一个个的去量取去计算的话会很麻烦的，所以才想有个LISP程序来弄一下，我自己又不会。。。

461045462

路；追逐~ 发表于 2012-5-10 19:56
嗯，房产图。。。
哥，你是知道的，要是一个个的去量取去计算的话会很麻烦的，所以才想有个LISP程序来弄 ...

有标注在中心和求和的程序，可以组合起来。我目前也只是收集了这样的，因为暂没做房产，就没有组合到一起。
见谅。

hlmdf

2. (princ "\n统计面积：TA    统计长度并标注：TAT")
   
3. (defun c:TA(/ ss tarea obj k l)
   
4.   (setvar "cmdecho" 0)
   
5.   (if (setq ss (ssget))
   
6.     (progn
   
7.       (vl-load-com)
   
8.       (setq l (sslength ss) k 0 tarea 0 )
   
9.       (repeat l
   
10.         (setq ename (ssname ss k))
    
11.         (setq obj (vlax-ename->vla-object ename))
    
12.         (if (vlax-property-available-p obj "area")
    
13.           (setq tarea (+ (vlax-get-property obj 'area) tarea))
    
14.         )
    
15.         (setq k (1+ k))
    
16.       )
    
17.       (setq tarea (/ tarea 1000000))
    
18.       (princ (strcat "\n共选择 " (itoa l) " 个对象 | 总面积: " (rtos tarea 2 2)))
    
19.     )
    
20.     (princ "\n未选择对象")
    
21.   )
    
22.   (setvar "cmdecho" 1)
    
23.   (prin1)
    
24. )
    
25. 
    
26. (defun c:TAT(/ ss tarea obj k l)
    
27.   (setvar "cmdecho" 0)
    
28.   (if (setq ss (ssget))
    
29.     (progn
    
30.       (vl-load-com)
    
31.       (setq l (sslength ss) k 0 tarea 0 )
    
32.       (repeat l
    
33.         (setq ename (ssname ss k))
    
34.         (setq obj (vlax-ename->vla-object ename))
    
35.         (if (vlax-property-available-p obj "area")
    
36.           (setq tarea (+ (vlax-get-property obj 'area) tarea))
    
37.         )
    
38.         (setq k (1+ k))
    
39.       )
    
40.       (setq tarea (/ tarea 1000000))
    
41.       (princ (strcat "\n共选择 " (itoa l) " 个对象 | 总面积: " (rtos tarea 2 2)))
    
42.       (command "text" (getpoint "\n选取文字插入点") "" "" (rtos tarea 2 2))
    
43.     )
    
44.     (princ "\n未选择对象")
    
45.   )
    
46.   (setvar "cmdecho" 1)
    
47.   (prin1)
    
48. )

(princ "\n统计面积：TA    统计长度并标注：TAT")<br /> (defun c:TA(/ ss tarea obj k l)<br />   (setvar "cmdecho" 0)<br />   (if (setq ss (ssget))<br />     (progn<br />       (vl-load-com)<br />       (setq l (sslength ss) k 0 tarea 0 )<br />       (repeat l<br />         (setq ename (ssname ss k))<br />         (setq obj (vlax-ename->vla-object ename))<br />         (if (vlax-property-available-p obj "area")<br />           (setq tarea (+ (vlax-get-property obj 'area) tarea))<br />         )<br />         (setq k (1+ k))<br />       )<br />       (setq tarea (/ tarea 1000000))<br />       (princ (strcat "\n共选择 " (itoa l) " 个对象 | 总面积: " (rtos tarea 2 2)))<br />     )<br />     (princ "\n未选择对象")<br />   )<br />   (setvar "cmdecho" 1)<br />   (prin1)<br /> )<br /> <br /> (defun c:TAT(/ ss tarea obj k l)<br />   (setvar "cmdecho" 0)<br />   (if (setq ss (ssget))<br />     (progn<br />       (vl-load-com)<br />       (setq l (sslength ss) k 0 tarea 0 )<br />       (repeat l<br />         (setq ename (ssname ss k))<br />         (setq obj (vlax-ename->vla-object ename))<br />         (if (vlax-property-available-p obj "area")<br />           (setq tarea (+ (vlax-get-property obj 'area) tarea))<br />         )<br />         (setq k (1+ k))<br />       )<br />       (setq tarea (/ tarea 1000000))<br />       (princ (strcat "\n共选择 " (itoa l) " 个对象 | 总面积: " (rtos tarea 2 2)))<br />       (command "text" (getpoint "\n选取文字插入点") "" "" (rtos tarea 2 2))<br />     )<br />     (princ "\n未选择对象")<br />   )<br />   (setvar "cmdecho" 1)<br />   (prin1)<br /> )

TAT注意设置textsize

路；追逐~

461045462 发表于 2012-5-11 07:45
有标注在中心和求和的程序，可以组合起来。我目前也只是收集了这样的，因为暂没做房产，就没有组合到一起 ...

呵呵，我的思路也是那样的，正在研究嫁接在一起。。。
我想问问，要是我要一次性选择某图层的全部实体，应该用什么代码呢？？？您知道不啊………………

路；追逐~

hlmdf 发表于 2012-5-11 08:48
TAT注意设置textsize

谢谢，研究研究，争取弄出来我下个要的……

461045462

路；追逐~ 发表于 2012-5-11 10:09
呵呵，我的思路也是那样的，正在研究嫁接在一起。。。
我想问问，要是我要一次性选择某图层的全部实体， ...

(command "-layer" "on" "*" "")
;“*” 表示打开所有的
下面有一个不知能用上否。见笑
(defun c:mj06 (/ ss sum obj n)
  ;;显示面积总和
  (vl-load-com)
  (setq ss (ssget))
  (setq        sum 0
        n 0
  )
  (while (< n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss n)))
    (if        (vlax-property-available-p obj "area")
      (setq sum (+ sum (vla-get-area obj)))
    )
    (setq n (1+ n))
  )
  sum
)

路；追逐~

461045462 发表于 2012-5-11 10:29
(command "-layer" "on" "*" "")
;“*” 表示打开所有的
下面有一个不知能用上否。见笑

谢谢，研究研究

lxh410224

(defun bz()