[LISP程序]：关于求面积问题

sure1008

统计拆迁面积的时候有N多小多边形，有没有程序可以全选后给出总面积，多谢

yuer0103

你是哪的，在下现在正做的这个，咱们切磋切磋！
先给个可以逐个标注面积的。
[PHP](defun c:mjbz(/ int ent pt mj ss ll ent mj zbiao pt n)
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (command "layer" "m" "MJZJ" "c" "6" "MJZJ" "")
  (setq ent (entsel"\n选择标示面积的对象: "))
         (while ent
           (setq ent (car ent))
           (redraw ent 3)
           (setq pt (getpoint"\n指定位置: "))
           (redraw ent 4)
           (setq mj (vla-get-area (vlax-ename->vla-object ent)))
           (command "text" "j" "m" pt 2.5 0.0 (rtos mj 2 1))
           (setq ent (entsel"\n选择标示面积的对象: "))
         );;;end of while
(princ))
[/PHP]

再来一个，我一直都在用的这个，自觉还可以：
[PHP]
(defun c:mjbz(/ int ent pt mj ss ll ent mj zbiao pt n)
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (command "layer" "m" "MJZJ" "c" "6" "MJZJ" "")
  (princ "\n选择标示面积的对象: ")
  (setq ss (ssget '((-4 . "<or")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "or>"))))

         (setq ll (sslength ss) n 0 totalmj 0.0)
         (repeat ll
           (setq ent (ssname ss n))
           (setq mj (vla-get-area (vlax-ename->vla-object ent)))
           (if (and (/= mj nil)(/= mj 0.0)) (setq totalmj (+ totalmj mj)))           (setq n (1+ n))
         );;;end of repeat

  (setq pt (getpoint"\n指定总面积注记位置: "))
  (command "text" "j" "m" pt 8.0 0.0  (rtos totalmj 2 2))
(princ))
[/PHP]


欢迎大家都来切磋技艺！

sure1008

怎么不能用 阿，我做市政的，偶偶做做规划，方案设计什么的

taner

最初由 sure1008 发布
[B]统计拆迁面积的时候有N多小多边形，有没有程序可以全选后给出总面积，多谢 [/B]

不記得在哪找的這個,蠻好用的.[PHP](defun c:aream (/          olderr    oldcmdecho                errexit
                undox          restore   ss1              nr        en
                tot_area
               )
  (defun errexit (s)
    (restore)
  )
  (defun undox ()
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
  )
  (setq        olderr        *error*
        restore        undox
        *error*        errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (if (setq ss1        (ssget '((-4 . "<OR")
                         (0 . "POLYLINE")
                         (0 . "LWPOLYLINE")
                         (0 . "CIRCLE")
                         (0 . "ELLIPSE")
                         (0 . "SPLINE")
                         (0 . "REGION")
                         (-4 . "OR>")
                        )
                )
      )
    (progn
      (setq nr 0)
      (setq tot_area 0.0)
      (setq en (ssname ss1 nr))
      (while en
        (command "._area" "_O" en)
        (setq tot_area (+ tot_area (getvar "area")))
        (setq nr (1+ nr))
        (setq en (ssname ss1 nr))
      )
      (princ "\nTotal Area = ")
      (princ tot_area)
    )
  )
  (restore)
)[/PHP]