整不下去了，谁帮我完善一下求嵌套面积程序，很有用啊

soly2006

是求个嵌套型的程序，试了半天，还是不行，高手们指点一下。如图，其中825.15是线面积，没扣除的，而要的是718.176面积。

2. (defun c:t3        () ;主程序
   
3.   (setq blc (/ (getvar "USERR1") 1000))
   
4.   (if (= blc 0.0)
   
5.     (setq blc 0.5)
   
6.   )                                        ;设定比例尺
   
7.   (While (Progn        (SetQ pen (Car (EntSel "\n指定一条 LWPolyLine: ")))
   
8.                 (princ pen)
   
9.                 (/= "LWPOLYLINE" (Cdr (Assoc 0 (EntGet pen))))
   
10.          )
    
11.     (Alert "所指对象不是 PolyLine，请重新指定...")
    
12.   )
    
13.   (setq bp (getpoint "点取标注位置："))
    
14.   (command ".TEXT"
    
15.            bp
    
16.            (* blc 6)
    
17.            ""
    
18.            (strcat "【面 积】 = " (rtos (pll pen) 2 3))
    
19.   )
    
20.   (princ)
    
21. )
    
22. ;;; ==================================================================
    
23. ;;;              求嵌套线的面积（如果有扣除内部的）                        
    
24. ;;; ==================================================================
    
25. (Defun PLL (plen / sset1 erea1)
    
26.   (PrinC "\n。。。。。")
    
27.   (setq        sset1 (ssget "F"
    
28.                      (txt1-get-allvertexs plen)
    
29.                      '((0 . "LWPolyline") (8 . "面积线"))
    
30.               )
    
31.   )
    
32.         (princ sset1)
    
33.   (if (= sset1 NIL)
    
34.     (setq erea1 (vlax-curve-getArea (vlax-ename->vla-object plen)))               
    
35.                   (progn
    
36.                           (setq n (sslength sset1))
    
37.                                 (setq j 0)
    
38.          (repeat n
    
39.                            (setq erea1 (vlax-curve-getArea (vlax-ename->vla-object plen)))
    
40.                 (setq erea1 (- erea1 (pll (ssname sset1 0)) ))
    
41.                                         (setq j (+ 1 j))
    
42.                      )
    
43.        )
    
44.   )
    
45. )
    
46. 
    
47. ;;; ==================================================================
    
48. ;;;              求多义线所有顶点.返回所有顶点表.
    
49. ;;; ==================================================================
    
50. (defun txt1-get-allvertexs (ename / plist pp n obj)
    
51.   (setq obj (vlax-ename->vla-object ename))
    
52.   (setq        plist (vlax-safearray->list
    
53.                 (vlax-variant-value
    
54.                   (vla-get-coordinates obj)
    
55.                 )
    
56.               )
    
57.   )
    
58.   (setq n 0)
    
59.   (repeat (/ (length plist) 2)
    
60.     (setq pp (append
    
61.                pp
    
62.                (list (list (nth n plist) (nth (1+ n) plist)))
    
63.              )
    
64.     )
    
65.     (setq n (+ n 2))
    
66.   )
    
67.   pp
    
68. )

(defun c:t3        () ;主程序<br />   (setq blc (/ (getvar "USERR1") 1000))<br />   (if (= blc 0.0)<br />     (setq blc 0.5)<br />   )                                        ;设定比例尺<br />   (While (Progn        (SetQ pen (Car (EntSel "\n指定一条 LWPolyLine: ")))<br />                 (princ pen)<br />                 (/= "LWPOLYLINE" (Cdr (Assoc 0 (EntGet pen))))<br />          )<br />     (Alert "所指对象不是 PolyLine，请重新指定...")<br />   )<br />   (setq bp (getpoint "点取标注位置："))<br />   (command ".TEXT"<br />            bp<br />            (* blc 6)<br />            ""<br />            (strcat "【面 积】 = " (rtos (pll pen) 2 3))<br />   )<br />   (princ)<br /> )<br /> ;;; ==================================================================<br /> ;;;              求嵌套线的面积（如果有扣除内部的）                         <br /> ;;; ==================================================================<br /> (Defun PLL (plen / sset1 erea1)<br />   (PrinC "\n。。。。。")<br />   (setq        sset1 (ssget "F"<br />                      (txt1-get-allvertexs plen)<br />                      '((0 . "LWPolyline") (8 . "面积线"))<br />               )<br />   )<br />         (princ sset1)<br />   (if (= sset1 NIL)<br />     (setq erea1 (vlax-curve-getArea (vlax-ename->vla-object plen)))                <br />                   (progn<br />                           (setq n (sslength sset1))<br />                                 (setq j 0)<br />          (repeat n<br />                            (setq erea1 (vlax-curve-getArea (vlax-ename->vla-object plen)))<br />                 (setq erea1 (- erea1 (pll (ssname sset1 0)) ))<br />                                         (setq j (+ 1 j))<br />                      )<br />        )<br />   )<br /> )<br /> <br /> ;;; ==================================================================<br /> ;;;              求多义线所有顶点.返回所有顶点表.<br /> ;;; ==================================================================<br /> (defun txt1-get-allvertexs (ename / plist pp n obj)<br />   (setq obj (vlax-ename->vla-object ename))<br />   (setq        plist (vlax-safearray->list<br />                 (vlax-variant-value<br />                   (vla-get-coordinates obj)<br />                 )<br />               )<br />   )<br />   (setq n 0)<br />   (repeat (/ (length plist) 2)<br />     (setq pp (append<br />                pp<br />                (list (list (nth n plist) (nth (1+ n) plist)))<br />              )<br />     )<br />     (setq n (+ n 2))<br />   )<br />   pp<br /> )

文件在这里，上面看起来太乱，为什么？http://bbs.mjtd.com/forum.php?mod=attachment&aid=NjUxNjR8ODg2NjMzNmZlMjE2MjRkNjdhNWM2ODI3MmM4OTliMjh8MTczMjQ4MzU1OQ%3D%3D&request=yes&_f=.lsp

soly2006

噫 ，发上去了没有乱啊，没经验，各位，看你们的了。或给些思路。其中c:pll改为pll

PhantomFox

有必要么，直接转成面域，相减不就可以了？

soly2006

PhantomFox 发表于 2012-3-9 15:41
有必要么，直接转成面域，相减不就可以了？

单个好说，直接计算器都搞得定，不管用面域与否，都得进行内部判断，
如上图，什么方法统计面积？？我说的是程序，不是手工。

soly2006

自己动手丰衣足食，已解决。

wau2000022

小儿科

461045462

soly2006 发表于 2012-3-9 16:58
自己动手丰衣足食，已解决。

请问能否发上dwg文件看看。
谢谢

xiabin68

好像南方就可以哦，，，，，

461045462

xiabin68 发表于 2013-1-26 19:44
好像南方就可以哦，，，，，

请问南方有此功能吗？
没有找到

461045462

soly2006 发表于 2012-3-9 16:58
自己动手丰衣足食，已解决。

您好：
试了试，楼上的程序或许是我操作有误，没有得到结果。
请指教。
谢谢！