yxh1202 发表于 2013-5-26 12:38:55

求闭合区域所有顶点

本帖最后由 Gu_xl 于 2013-5-26 18:44 编辑

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

zmzk 发表于 2020-2-21 22:20:42

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

vlisp2012 发表于 2013-5-26 18:15:08

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

nzl1116 发表于 2013-5-27 05:13:46

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

nzl1116 发表于 2013-5-27 09:28:16

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

yxh1202 发表于 2013-5-27 11:17:29

nzl1116 发表于 2013-5-27 05:13 static/image/common/back.gif
多段线自交形成的面积算不算？

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

香田里浪人 发表于 2013-6-6 21:29:13

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

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

yxh1202 发表于 2013-6-9 16:22:24

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

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

香田里浪人 发表于 2013-6-9 19:31:36

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

合并多线段就可以。

yshf 发表于 2013-6-9 21:31:23

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

yxh1202 发表于 2013-9-10 15:20:13

nzl1116 发表于 2013-5-27 09:28 static/image/common/back.gif
先假设多段线不自交

谢谢你的帮忙，这个代码只适合2个图元对吧。能不能实现多个图元选择后求的面积呢，请不吝赐教
页: [1] 2
查看完整版本: 求闭合区域所有顶点