[LISP程序]：请教统计面积的好方法

naster

学有涯，而知也无涯！
都是高手阿，惭愧！

bonme

太好了

心竹

论坛上已经有很多关于曲线面积的帖子
     [U]           求曲线面积的LISP程序 -by 秋枫   [/COLOR]    [/U]      
       [U]         统计曲线面积程序。     [/COLOR]     [/U]      
       [U]        请高手帮小弟编个关于计算面积的小程序    [/COLOR]     [/U]      
       [U]         如图示的两条多义线，如何得到两者之间的面积     [/COLOR]     [/U]      
       [U]         在图中自动标注面积     [/COLOR]     [/U]      

       [U]       准备写一些关于各种面积统计的程序。       [/COLOR]     [/U]      
       [U]              [/COLOR]     [/U]      

下面是xd工具箱量取曲线面积的演示

       [U]              [/COLOR]     [/U]      

cxc339

应该下载小东工具箱

lhjlyy0

多谢各位高手，下了。

Qming

都是高手啊工具箱 里的具体功能能不能单独出文件呢
因为用不到所有的

沙漠里的绿色

用我的程序试试看，估计能解决你的问题


上传的附件 tmp.lsp (大小:0.83 KB,46次下载)

grape

看看，我也正在为面积发愁

青马

;****************************************************面积求和(可标注公顷，亩，平方米)

(defun c:555 (/              olderr   oldcmdecho         errexit  undox
             restore  ss1      nr        en         tot_area sc
             BL-bz    bz2      pt        pt1
            )
  (cmdla0)
  (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))
      )
      (setq tot_area (* tot_area 0.000001))
      (princ "\n面积之和 = ")
      (princ tot_area)
    )
  )
  (setq sc 0.1)
  (if (= (tblsearch "style" "宋体") nil)
    (COMMAND "style" "宋体" "宋体" (* SC 30000) "1" "0" "" "")
  )
  (initget "A B C")
  (setq
    BL-bz (getkword "\n请选择标注单位 A-平方米/B-亩/C-公顷.<平方米>:")
  )
  (initget "Y N")
  (setq bz2 (getkword "需要标注单位名称吗?Y/<N>"))
  (setq pt (getpoint "\n 标注面积的起点:"))
  (while pt
    (setq pt1 pt)
    (setq bz2 (if bz2
                bz2
                "N"
              )
    )

    (if        (= bz2 "N")
      (progn
        (setq BL-bz (if        BL-bz
                      BL-bz
                      "A"
                    )
        )
        (if (= bl-bz "A")
          (setq tot_area (rtos (/ tot_area 1.0) 2 2))
        )
        (if (= bl-bz "B")
          (setq tot_area (rtos (/ tot_area (/ 2000.0 3)) 2 2))
        )
        (if (= bl-bz "C")
          (setq tot_area (rtos (/ tot_area 10000.0) 2 4))
        )
      )
      (progn
        (setq BL-bz (if        BL-bz
                      BL-bz
                      "A"
                    )
        )
        (if (= bl-bz "A")
          (setq tot_area (strcat (rtos (/ tot_area 1.0) 2 2) "平方米"))
        )
        (if (= bl-bz "B")
          (setq
            tot_area
             (strcat (rtos (/ tot_area (/ 2000.0 3)) 2 2) "亩")
          )
        )
        (if (= bl-bz "C")
          (setq
            tot_area (strcat (rtos (/ tot_area 10000.0) 2 4) "公顷")
          )
        )
      )
    )
    (command "text" "j" "mc" pt1 "0" tot_area)
  )
  (cmdla1)

)


(Defun cmdla0 ()
  (Setq        cmdech (Getvar "Cmdecho")
        oom    (Getvar "Orthomode")
        osm    (Getvar "Osmode")
        la     (Getvar "Clayer")
  )
  (Setvar "Cmdecho" 0)
  (Setvar "Regenmode" 0)
)

;;; 恢复原有系统变量
(Defun cmdla1 ()
  (Setvar "Cmdecho" cmdech)
  (Setvar "Clayer" LA)
  (Setvar "Orthomode" oom)
  (Setvar "Osmode" osm)
  (setvar "regenmode" 1)
  (Terpri)
  (Princ)
)


;****************************************************面积求和
(defun c:55 (/ olderr oldcmdecho errexit undox restore ss1 nr en
                tot_area a)
  (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))
      )
      (setq tot_area (rtos (* tot_area 0.000001) 2 2))
      (princ "\n面积之和 = ")
      (princ tot_area)
    )
  )
  (setq dimsca (cdr (assoc 40 (tblsearch "dimstyle" "normal"))))
  (setq a (* 400 dimsca))
  (setq pt (getpoint "\n 标注面积的起点:"))
  (setq        pt1 (list (+ (car pt) (+ a (/ a 10)))
                  (+ (cadr pt) (* 0.8 a))
            )
        pt2
            (list (+ (car pt) (/ a 5)) (cadr pt))
  )
  (command "layer" "m" "面积标注" "c" "1" "" "")

  (command "text" "j" "r" pt a "0" tot_area)
  (command "clayer" soula)
  (setvar "cmdecho" 1)

)
你试试这个，我有一个规划局的朋友让我给他编的

1笑2过

请哪位高手编写一个能在一个封闭区域中可以自动标注出面积与周长的程序。
非常感谢了！

bonebone715

好多高手

luoruibin

统计面积,南方CASS也可以啊

sunset_long

好

zhangfp

最初由 YAMA 发布
[B]如果用命令的话，可以考虑boundary,它可以得出边界线. [/B]

非常感谢，的确不错！
能教小弟学习lisp吗？？

lhfdyh

只有大家互相帮助才能不断提高