[LISP程序]：我编制的面积求解工具 请指点交流

xiaping

参考各位大侠的作品，我也写了一个求面积的程序。请大家多提意见，相互交流进一步完善。
程序主要特点：
1、支持批量选定需要求面积的实体；
2、根据用户要求进行面积的加、减；
3、对于直线组成的封闭图形可以先组成面域然后求出面积；
4、可以根据用户所提供求出面积的壁厚计算重量。
5、支持选定的实体有圆、弧、椭圆、轻型多段线、多段线、面域、或平面封闭样条曲线构成的封闭面积；
6、面积以平方米为单位输出。
7、加载程序以后，在命令行输入MJ即可调用。
暂时没有加入按比例求面积的功能。
[php]

(defun c:MJ ( / bh hd hd1 n obj oldcmdecho p1 ss sum tt tw zmj zzl)
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq        zmj 0
        sum 0
        n 0
  )
  (setq tt 1)
  (while (= tt 1)
    (setq
      hd (getint
           " 创建面域计算面积 / 选取实体计算面积/ 退出 ? 1/2/3 <2>"
         )
    )
    (if        (= hd nil)
      (setq hd 2)
    )
    (if        (/= hd 3)
      (progn
        (setq hd1 (getstring "相加/扣减?  +/- <+>"))
        (if (or (= hd1 "") (= hd1 nil))
          (setq hd1 "+")
        )
      )
    )
    (if        (= hd 2)
      (progn
        (setq ss (ssget        '((-4 . "<OR")
                          (0 . "Arc")
                          (0 . "Circle")
                          (0 . "Ellipse")
                          (0 . "LWPOLYLINE")
                          (0 . "POLYLINE")
                          (0 . "Region")
                          (0 . "Spline")
                          (-4 . "OR>")
                         )
                 )
        )
        (setq sum 0
              n        0
        )
        (if (= hd1 "+")
         (progn
            (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)) 1000000))
              )
              (setq n (1+ n))
            )
            (setq zmj (+ zmj sum))
          )
          (progn
            (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)) 1000000))
              )
              (setq n (1+ n))
            )
            (setq zmj (+ zmj sum))
          ))

        ;)
        (princ "\n当前计算面积(m2)= ")
        (princ zmj)
        (princ "\n")
      )
    )
    (if        (= hd 1)
      (progn
        (if (setq p1 (getpoint "\n选择闭合区域内任意一点建立面域"))
          (progn
            (command "boundary" p1 "")
            (command "._area" "_O" "L")
            (setq sum (/ (getvar "area") 1000000))
          )
        )
        (if (= hd1 "+")
          (setq zmj (+ zmj sum))
          (setq zmj (-zmj sum))
        )
        (princ "\n当前计算面积(m2)= ")
        (princ zmj)
        (princ "\n")
      )
    )
    (if        (= hd 3)
      (progn
        (setq tw (getint "是否计算金属材料重量？ 计算1 /不计算 2 <1>"))
        (if (or (= tw nil) (= tw ""))
          (setq tw 1)
        )
        (if (= tw 1)
          (progn
            (setq bh (getreal "壁厚(mm)?"))
            (setq zzl (* zmj bh 7.85))
            (princ "\n总面积(m2)= ")
            (princ zmj)
            (princ "\n 净重")
            (princ zzl)
            (setq tt nil)
          )
        )
        (setq tt nil)
      )
    )
  )
  (setvar "cmdecho" oldcmdecho)
  (princ)
)

[/php]

自由的鱼

功能很强大！

Free-Lancer

1 ssget 这样写更简洁

1. (ssget
   
2.   '((0 . "Arc,Circle,Ellipse,*POLYLINE,Region,Spline"))
   
3. )

复制代码

2 (command "boundary" p1 "")  不一定生成面域，建议使用

2. 
   
3.   (if (setq e (bpoly p1))
   
4.    ...
   
5.   )
   

<br />   (if (setq e (bpoly p1))<br />    ...<br />   )<br />

梦断江南

完善一下，把bpoly排除孤岛写出来吧：）

lsjjm

去除孤岛的面积
REFER TO
1. http://www.xdcad.net/forum/showt ... hlight=%C3%E6%BB%FD 或
2. 先建HATCH>面积

Free-Lancer

最初由 梦断江南 发布
[B]完善一下，把bpoly排除孤岛写出来吧：） [/B]

Bpoly是忽略孤岛的，只形成外环。Boundary不忽略孤岛，可以这样处理：
1 记录 （entlast）
2 使用 Boundary 后判定 entlast 是不是多了，如果多了，将多出的部分生成面域。
3 用最大面积的面域减去其他面域面积
4 删除临时 面域实体。

xiaping

谢谢各位赐教，对于孤岛的处理我再学习一下。

它山之石

6楼楼主说的对，我也写了个类似的程序，当时主要是对格筏基础求面积，要先求出外轮廓面积，后减去内部孤岛面积。也是采用的那个办法。
回头我把我的源程序，贴出来给大家讨论。

xiaping

最初由 它山之石 发布
[B]6楼楼主说的对，我也写了个类似的程序，当时主要是对格筏基础求面积，要先求出外轮廓面积，后减去内部孤岛面积。也是采用的那个办法。
回头我把我的源程序，贴出来给大家讨论。 [/B]

希望早点看到你的程序。如何自动判定并括除孤岛面积，还是没有一个清晰的思路。希望得到各位进一步明确地指点。谢谢！

梦断江南

最初由 lsjjm 发布
[B]去除孤岛的面积
REFER TO
1. http://www.xdcad.net/forum/showt ... hlight=%C3%E6%BB%FD 或
2. 先建HATCH>面积 [/B]

楼主的程序已经提供面积 +，- 功能，你链接中的程序也是这个方法，并无特别之处，我觉得6楼的思路不错。
提出这个“孤岛”的话题，主要是想简化步骤，“自动化”一些，只要在cad空间空白处点一下就自动求面积（有孤岛自动排除孤岛面积－不用再去选一轮，点中实体返回0，没有在封闭区域内返回nil或则0）

其实这个步骤和hatch差不多。
但是用hatch方法，反求面积并不容易。就算可做到，也是绕了个弯

xiaping

6楼搂主的思路是不错，但是如何取得孤岛的选择集比较困难，目前还没有找到好的解决办法。正如梦版主所言，提出孤岛关键是提高“自动化”识别并排除孤岛面积的问题。

lsjjm

10,11楼:
请参考
重建填充边界并求面积
http://www.xdcad.com/forum/showthread.php?s=&threadid=161134

Free-Lancer

最初由 xiaping 发布
[B]6楼搂主的思路是不错，但是如何取得孤岛的选择集比较困难，目前还没有找到好的解决办法。正如梦版主所言，提出孤岛关键是提高“自动化”识别并排除孤岛面积的问题。 [/B]

孤岛问题就是 Region In Region，在ARX版 RAVE 斑竹曾有过 ARx 代码，当然Lisp的效率不能和ARX比，但可以用来参考
http://www.xdcad.net/forum/showt ... d=308317#post308317

xiaping

基本搞定，对于组合图形点击A点以后的计算结果如下图所示，正确地排除了孤岛面积。但是适用范围还需要进一步验证。
另外，解决了孤岛面积扣除问题以后 "－"面积的计算似乎已无必要，各位觉得如何？

shisj

更新的程序是不是顶上的那一个啊？谢谢楼主提供好东西