求闭合区域所有顶点

yxh1202

由于工作需要，经常计算各种工程量。简化的说就是，选择两个图层上的多线段，要计算两个多线段形成的闭合区域面积。我看了好多的帖子，整理了一个思路，请高人指点：
    如图：
1、选择图册实体，获得多线段所有顶点，生成列表
2、根据选择的多线段获得交点，添加到列表
3、根据 交点1和交点2。现在需要遍历  线段1  和线段2。  用线段1的顶点至起点的距离L1与  交点到线段顶点的距离L  比较，如果  L1≥L，则保留至点列表，如果 L1<L,则剔除。反之，如果交点距离端点近，则判断公式反用即可。
4、根据新的点列表，计算闭合区域面积。

zmzk

厉害！10年前就编出这么优秀的程序，晚辈望尘莫及！

vlisp2012

http://bbs.mjtd.com/thread-80267-1-1.html
这里有你需要的，做好多段线之后。就得到面积了！

nzl1116

多段线自交形成的面积算不算？

nzl1116

先假设多段线不自交

1. (defun intersectPts (vlaobj1 vlaobj2 / ptsVar ptsArray value point)
   
2.   (setq        ptsVar         (vla-intersectwith vlaobj1 vlaobj2 acExtendNone)
   
3.         ptsArray (vlax-variant-value ptsVar)
   
4.         ptsList         (vl-catch-all-apply 'vlax-safeArray->list (list ptsArray))
   
5.         value    nil
   
6.   )
   
7.   (if (vl-catch-all-error-p ptsList)
   
8.     (setq ptsList nil)
   
9.   )
   
10.   (while ptsList
    
11.     (setq point          (list (car ptsList) (cadr ptsList) (caddr ptsList))
    
12.           value          (append value (list point))
    
13.           ptsList (cdddr ptsList)
    
14.     )
    
15.   )
    
16.   value
    
17. )
    
18. (defun c:tt (/ PLEname0 PLEname1 PntLst PrmLst0 PrmLst1 PntLst0 PntLst1 ClosedArea SumArea)
    
19.   (and
    
20.     (setq PLEname0 (car (entsel)))
    
21.     (setq PLEname1 (car (entsel)))
    
22.     (> (length (setq PntLst (intersectPts (vlax-ename->vla-object PLEname0) (vlax-ename->vla-object PLEname1)))) 1)
    
23.     (progn
    
24.       (setq PrmLst0 (mapcar (function (lambda (x) (vlax-curve-getparamatpoint PLEname0 x))) PntLst)
    
25.             PrmLst0 (mapcar (function (lambda (x) (* x 0.5))) (mapcar '+ PrmLst0 (cdr PrmLst0)))
    
26.             PrmLst1 (mapcar (function (lambda (x) (vlax-curve-getparamatpoint PLEname1 x))) PntLst)
    
27.             PrmLst1 (mapcar (function (lambda (x) (* x 0.5))) (mapcar '+ PrmLst1 (cdr PrmLst1)))
    
28.             PntLst0 (mapcar (function (lambda (x) (vlax-curve-getpointatparam PLEname0 x))) PrmLst0)
    
29.             PntLst1 (mapcar (function (lambda (x) (vlax-curve-getpointatparam PLEname1 x))) PrmLst1)
    
30.             PntLst  (mapcar (function (lambda (x y) (mapcar '* (mapcar '+ x y) '(0.5 0.5 0.5)))) PntLst0 PntLst1)
    
31.             SumArea 0.0
    
32.       )
    
33.       (foreach Item PntLst
    
34.         (setq ClosedArea (bpoly Item)
    
35.               SumArea         (+ SumArea (vlax-curve-getarea ClosedArea))
    
36.         )
    
37.         (entdel ClosedArea)
    
38.       )
    
39.       (princ SumArea)
    
40.     )
    
41.   )
    
42.   (princ)
    
43. )

(defun intersectPts (vlaobj1 vlaobj2 / ptsVar ptsArray value point)<br />   (setq        ptsVar         (vla-intersectwith vlaobj1 vlaobj2 acExtendNone)<br />         ptsArray (vlax-variant-value ptsVar)<br />         ptsList         (vl-catch-all-apply 'vlax-safeArray->list (list ptsArray))<br />         value    nil<br />   )<br />   (if (vl-catch-all-error-p ptsList)<br />     (setq ptsList nil)<br />   )<br />   (while ptsList<br />     (setq point          (list (car ptsList) (cadr ptsList) (caddr ptsList))<br />           value          (append value (list point))<br />           ptsList (cdddr ptsList)<br />     )<br />   )<br />   value<br /> )<br /> (defun c:tt (/ PLEname0 PLEname1 PntLst PrmLst0 PrmLst1 PntLst0 PntLst1 ClosedArea SumArea)<br />   (and<br />     (setq PLEname0 (car (entsel)))<br />     (setq PLEname1 (car (entsel)))<br />     (> (length (setq PntLst (intersectPts (vlax-ename->vla-object PLEname0) (vlax-ename->vla-object PLEname1)))) 1)<br />     (progn<br />       (setq PrmLst0 (mapcar (function (lambda (x) (vlax-curve-getparamatpoint PLEname0 x))) PntLst)<br />             PrmLst0 (mapcar (function (lambda (x) (* x 0.5))) (mapcar '+ PrmLst0 (cdr PrmLst0)))<br />             PrmLst1 (mapcar (function (lambda (x) (vlax-curve-getparamatpoint PLEname1 x))) PntLst)<br />             PrmLst1 (mapcar (function (lambda (x) (* x 0.5))) (mapcar '+ PrmLst1 (cdr PrmLst1)))<br />             PntLst0 (mapcar (function (lambda (x) (vlax-curve-getpointatparam PLEname0 x))) PrmLst0)<br />             PntLst1 (mapcar (function (lambda (x) (vlax-curve-getpointatparam PLEname1 x))) PrmLst1)<br />             PntLst  (mapcar (function (lambda (x y) (mapcar '* (mapcar '+ x y) '(0.5 0.5 0.5)))) PntLst0 PntLst1)<br />             SumArea 0.0<br />       )<br />       (foreach Item PntLst<br />         (setq ClosedArea (bpoly Item)<br />               SumArea         (+ SumArea (vlax-curve-getarea ClosedArea))<br />         )<br />         (entdel ClosedArea)<br />       )<br />       (princ SumArea)<br />     )<br />   )<br />   (princ)<br /> )

yxh1202

nzl1116 发表于 2013-5-27 05:13
多段线自交形成的面积算不算？

非常感谢你，解决了问题。
有时候别人绘制的图中有直线，有多线段。请问能处理一下吗。

香田里浪人

yxh1202 发表于 2013-5-27 11:17
非常感谢你，解决了问题。
有时候别人绘制的图中有直线，有多线段。请问能处理一下吗。

处理一下------什么意思，是不是合并？

yxh1202

香田里浪人 发表于 2013-6-6 21:29
处理一下------什么意思，是不是合并？

就是说，有直线和多线段混合的情况，也可以实现目的。请帮忙

香田里浪人

yxh1202 发表于 2013-6-9 16:22
就是说，有直线和多线段混合的情况，也可以实现目的。请帮忙

合并多线段就可以。

yshf

用BOUNDARY命令生成边界即可得到面积!

yxh1202

nzl1116 发表于 2013-5-27 09:28
先假设多段线不自交

谢谢你的帮忙，这个代码只适合2个图元对吧。能不能实现多个图元选择后求的面积呢，请不吝赐教