[LISP函数]：面积计算

tomtom

给大架提供一个面积计算程序
要求1。图纸必须按照比例绘制
      2。可计算各种面积，选择目标为封闭区域
      3。可进行多次选择，面积自动累加
      (DEFUN C:dlmj (   )
(if (= bl nil)(setq bl(getreal "input bl---:")))(setvar "userr1" bl)
(setq pt (getpoint "\n插入点:"))
(setq mmm 0.0)
  (while (/= pt nil)
  (command "layer" "s" "mj" "")
  (command "boundary" pt "")
  (command "region" "l" "")
  (command "massprop" "l" "" "y" "aa.mpr" "")
;  (command "erase" "l" "")
  (setq f1 (open "C:\aa.mpr" "r"))
  (setq j1 (read-line f1))
  (setq j2 (read-line f1))
  (setq j3 (read-line f1))
  (setq j4 (read-line f1))
  (setq j5 (read-line f1))
  (close f1)
  (setq j4 (substr j4 15 30))
  (setq j41 (atof j4))
  (setq j41 (* j41 bl) j41 (* j41 bl))
  (setq j41 (/ j41 1000.0) j41 (/ j41 1000.0))
  (setq mmm (+ mmm j41))
  (setq pt (getpoint "\n插入点:"))
  )
(setq nnn (rtos mmm 2 2))
(command "layer" "s" "0" "")
(setq pt (getpoint "\n输出点:"))
(command "text" pt "3" "0" nnn "")
)

小英英

请问怎么才能应用这个面积计算程序 。

Wildcat

把上段文字从(DEFUN 开始写到一个文本文档里，保存，改扩展名为LSP，再加载到CAD里。
在命令行键入dlmj起动。

cy956

请贴出"C:\aa.mpr“文件。起何作用？

tomtom

"C:\aa.mpr“为计算中间文件,用户无需考虑

weihong0371

一连串的输入也不知是什么意思？感觉用处不大！

tomtom

本程序是按比例求图中的多个封闭区域的面积，用户可用鼠标选取封闭区域内一点即可，对于多个封闭区域可分别选取，回车后程序即开始统计所选范围的总面积，可计算出多个封闭区的面积总和。

lyousme

如果将这个程序转换成ARX程序，应该怎么去做？

yeshuaxing

这里的CAD高手不少啊，有空时得常来看看

shisj

还是先生成面域，不用command命令可以实现面域生成吗？

自由的鱼

不错的程序！

aidraft

[php]
;;作者：AIdraft 5/9/2004
;;需要DosLib支持。本来还有一段分析重复边界的
;;但图中实体太多时出问题。
(defun C:AreaSum
                 (/            boundary+_lst        boundary- boundary+
                  elast            enext     OS_hold        msg          olderr
                  no            insPt     area        pt          doc
                  mspace    bdy-_ss   idx
                  )
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelspace doc))
  (IF (< (ATOI (SUBSTR (GETVAR "ACADVER") 1 2)) 16)
    (PROGN
      (PRINC
        "\nAutoCAD 2004或以上版本才能运行本程序."
        )
      (exit)
      )
    )
  (if (> (setq no (ent-number)) 1000)
    (if
      (=
        (dos_msgbox
          (strcat "屏幕中有"
                  (itoa no)
                  "个实体，真的要继续吗?"
                  )
          "Alert"
          4
          3
          )
        3
        )
       (exit)
       )
    )
  (setq        olderr        *error*
        msg        ""
        *error*        AreaSum-error
        )
  (setq boundary+_lst '())
  (setq        OS_hold          (getvar "OSMODE")
        echo_hold (getvar "CMDECHO")
        )
  (setvar "OSMODE" 0)
  (setvar "CMDECHO" 0)
  (while
    (setq
      pt (getpoint "\n选择内部点(请尽量靠近边界) <或按ENTER结束>: ")
      )
     (setq elast (entlast)
           boundary+ nil
           boundary- nil
           )
     (command "modemacro" "正在生成边界，请稍候...")
     (if (vl-catch-all-apply
           'bpoly
           (list pt)
           )
       (progn
         (entdel (entlast))
         (command "_.BPoly" "a" "o" "r" "" pt "")
         (setq enext   (entnext elast)
               bdy-_ss (ssadd)
               )
         (while        enext
           (if (eq enext (entnext elast))
             (setq boundary+ enext)
             (setq bdy-_ss (ssadd enext bdy-_ss))
             ) ;if
           (setq enext (entnext enext))
           ) ;while
         (cond
           ((= (sslength bdy-_ss) 1)
            (setq boundary- (ssname bdy-_ss 0))
            )
           ((> (sslength bdy-_ss) 1)
            (command "union" bdy-_ss "")
            (setq idx 0)
            (repeat (sslength bdy-_ss)
              (if (not (vlax-erased-p (ssname bdy-_ss idx)))
                (setq boundary- (ssname bdy-_ss idx))
                )
              (setq idx (1+ idx))
              ) ;repeat
            )
           ) ;cond
         (if boundary-
           (command "subtract" boundary+ "" boundary- "")
           )
         (if boundary+
           (setq boundary+_lst (cons boundary+ boundary+_lst))
           )
         ) ;progn
       ) ;IF
     (if boundary+_lst
       (highlight boundary+_lst 3)
       )
     (command "modemacro" " ")
     ) ;while
  (setq area 0)
  (if boundary+_lst
    (progn
      (foreach bdy boundary+_lst
        (setq
          area (+ area
                  (vla-get-area
                    (vlax-ename->vla-object bdy)
                    )
                  )
          )
        (entdel bdy)
        ) ;foreach
      (if (setq insPt (getpoint "\n文字插入点 <or回车显示结果>："))
        (vla-addText mspace (rtos area 2 2) (vlax-3d-point insPt) 3)
        (alert (strcat "总面积：" (rtos area 2 2) " 平方单位。"))
        )
      ) ;PROGN
    ) ;if
  (setvar "OSMODE" OS_hold)
  (setvar "CMDECHO" echo_hold)
  (vlax-release-object doc)
  (vlax-release-object mspace)
  (princ)
  ) ;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun highlight (entlst mode / en)
  (foreach en entlst
    (redraw en mode)
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ent-number (/ scrsize height width center llpt urpt enum ss)
  (setq scrsize (getvar "SCREENSIZE"))
  (setq        height (getvar "VIEWSIZE")
        width  (* height (/ (car scrsize) (cadr scrsize)))
        )
  (setq center (getvar "VIEWCTR"))
  (setq        llpt (polar (polar center pi (/ width 2.0))
                    (* pi 1.5)
                    (/ height 2.0)
                    )
        urpt (polar (polar center 0 (/ width 2.0))
                    (* pi 0.5)
                    (/ height 2.0)
                    )
        )
  (setq ss (ssget "w" llpt urpt))
  (if ss
    (setq enum (sslength ss))
    (setq enum 0)
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun AreaSum-error (msg)
  (if OS_hold
    (setvar "OSMODE" OS_hold)
    )
  (if echo_hold
    (setvar "CMDECHO" echo_hold)
    )
  (if (> (length boundary+_lst) 0)
    (mapcar 'entdel boundary+_lst)
    )
  (if olderr
    (setq *error* olderr)
    )
  ) ;  [/php]

saltxf

这里面可不可以计算形心？

aidraft

(vla-get-centroid boundary+)

tomtom

aidraft程序做的很好，但是较为麻烦，一楼的面积计算是用于acad14的，cad2004新作的面积计算及更多好程序见下面链接，下面是面积计算的范例，例1。分别求每个封闭区域面积；例2。求三个封闭面积的总和。例3。用例1求出的3个面积相加求和，来验证例2的正确性。
http://www.xdcad.net/forum/showthread.php?threadid=159073