多个区域面积求和

hphkjz

哪位大神能这个lisp代码，可以多个多段线面积求和。

ysq101

说明不够清楚啊~~~~来张图吧~~~

hphkjz

ysq101 发表于 2013-10-17 21:41
说明不够清楚啊~~~~来张图吧~~~

大哥，我手机上的，不好发图哦。意思就有好几个框起来的面积，怎么输入一个命令就能知道面积的和了。

zxq0220

2. (defun c:tt ()
   
3. (setvar "CMDECHO" 0)
   
4. (if (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1)))) (progn
   
5.   (setq i -1)
   
6.   (setq sum 0.0)
   
7.   (repeat (sslength ss)
   
8.    (setq en (ssname ss (setq i (1+ i))))
   
9.    (command "_.AREA" en "")
   
10.    (setq sum (+ (getvar "AREA") sum))
    
11.   )
    
12.   (print sum)
    
13. ))
    
14. (setvar "CMDECHO" 1)
    
15. (princ)
    
16. )

(defun c:tt ()<br /> (setvar "CMDECHO" 0)<br /> (if (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1)))) (progn<br />   (setq i -1)<br />   (setq sum 0.0)<br />   (repeat (sslength ss)<br />    (setq en (ssname ss (setq i (1+ i))))<br />    (command "_.AREA" en "")<br />    (setq sum (+ (getvar "AREA") sum))<br />   )<br />   (print sum)<br /> ))<br /> (setvar "CMDECHO" 1)<br /> (princ)<br /> )

hahadang

1. (defun C:aaaa (/ ss l i totalarea ename obj entarea)
   
2.   (if (setq ss (ssget))
   
3.     (progn
   
4.       (vl-load-com)
   
5.       (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
   
6.       (setq l (sslength ss) i 0 totalarea 0 totlength 0)
   
7.       (repeat l
   
8.         (setq ename (ssname ss i))
   
9.         (setq obj (vlax-ename->vla-object ename))
   
10. (if (vlax-property-available-p obj "area")
    
11.           (setq totalarea (+ (vlax-get-property obj 'area) totalarea))
    
12.         )
    
13. (if (= (cdr (assoc 0 (entget ename))) "MLINE")
    
14.    (setq totlength (+ totlength (ml-length ename)))
    
15.    (setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))
    
16. )
    
17.         (setq i (1+ i))
    
18.       )
    
19.       (setq text1 (strcat "总面积为: " (rtos totalarea 2 4) "平方单位")
    
20.      text2 (strcat "总长度为: " (rtos totlength 2 4) "单位")
    
21.       )
    
22.       (if (setq insertpt (getpoint "\n请输入文字插入点: "))
    
23. (if (setq height (getdist "\n请输入文字高度:"))
    
24.    (setq insertp1 (vlax-3d-point insertpt)
    
25.   insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))
    
26.          textobj1 (vla-addtext modelspace text1 insertp1 height)
    
27.   textobj2 (vla-addtext modelspace text2 insertp2 height)
    
28.    )
    
29. )
    
30.       )
    
31.     )
    
32.   )
    
33. )
    
34. (defun ml-length (ename / j d ptlist)
    
35.   (foreach n (entget ename)
    
36.     (if (= (car n) 11)
    
37.       (setq ptlist (cons (cdr n) ptlist))
    
38.     )
    
39.   )
    
40.   (reverse ptlist)
    
41.   (setq j 0 d 0)
    
42.   (repeat (1- (length ptlist))
    
43.     (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
    
44.     (setq j (1+ j))
    
45.   )
    
46.   d
    
47. )  
    
48. 
    

(defun C:aaaa (/ ss l i totalarea ename obj entarea)<br />   (if (setq ss (ssget))<br />     (progn<br />       (vl-load-com)<br />       (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))<br />       (setq l (sslength ss) i 0 totalarea 0 totlength 0)<br />       (repeat l<br />         (setq ename (ssname ss i))<br />         (setq obj (vlax-ename->vla-object ename))<br /> (if (vlax-property-available-p obj "area")<br />           (setq totalarea (+ (vlax-get-property obj 'area) totalarea))<br />         )<br /> (if (= (cdr (assoc 0 (entget ename))) "MLINE")<br />    (setq totlength (+ totlength (ml-length ename)))<br />    (setq totlength (+ totlength (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename))))<br /> )<br />         (setq i (1+ i))<br />       )<br />       (setq text1 (strcat "总面积为: " (rtos totalarea 2 4) "平方单位")<br />      text2 (strcat "总长度为: " (rtos totlength 2 4) "单位")<br />       )<br />       (if (setq insertpt (getpoint "\n请输入文字插入点: "))<br /> (if (setq height (getdist "\n请输入文字高度:"))<br />    (setq insertp1 (vlax-3d-point insertpt)<br />   insertp2 (vlax-3d-point (polar insertpt (* 1.5 Pi) (* 1.5 height)))<br />          textobj1 (vla-addtext modelspace text1 insertp1 height)<br />   textobj2 (vla-addtext modelspace text2 insertp2 height)<br />    )<br /> )<br />       )<br />     )<br />   )<br /> )<br /> (defun ml-length (ename / j d ptlist)<br />   (foreach n (entget ename)<br />     (if (= (car n) 11)<br />       (setq ptlist (cons (cdr n) ptlist))<br />     )<br />   )<br />   (reverse ptlist)<br />   (setq j 0 d 0)<br />   (repeat (1- (length ptlist))<br />     (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))<br />     (setq j (1+ j))<br />   )<br />   d<br /> )  <br /> <br />

hahadang

http://bbs.xdcad.net/forum.php?mod=viewthread&tid=667902这个是原版的帖子，你看看是不是你要的。

ysq101

zxq0220 发表于 2013-10-18 07:49

热心会员啊~~~~技术好..热心+1

st788796

这样更简单

1. (defun c:tt (/ ss)
   
2.   (if (setq ss (ssget '((0 . "region"))))
   
3.     (progn
   
4.       (princ "\nTotle Area = ")
   
5.       (princ (apply '+
   
6.                     (mapcar '(lambda (x) (xdrx_region_area x))
   
7.                             (xdrx_pickset->ents ss)
   
8.                     )
   
9.              )
   
10.       )
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )

(defun c:tt (/ ss)<br />   (if (setq ss (ssget '((0 . "region"))))<br />     (progn<br />       (princ "\nTotle Area = ")<br />       (princ (apply '+<br />                     (mapcar '(lambda (x) (xdrx_region_area x))<br />                             (xdrx_pickset->ents ss)<br />                     )<br />              )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

hphkjz

zxq0220 发表于 2013-10-18 07:49

非常非常感谢

hphkjz

hahadang 发表于 2013-10-18 09:59
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=667902这个是原版的帖子，你看看是不是你要的。

好的，谢谢

hphkjz

hahadang 发表于 2013-10-18 09:58

非常非常的感谢

hahadang

hphkjz 发表于 2013-10-19 03:56
非常非常的感谢

不客气，互帮互助嘛。