计算批量对象的面积

Lisphk · 发表于 2016-9-23 12:44:18

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Lisphk 于 2016-9-23 12:49 编辑

代码适合计算对象：POLYLINE、 LWPOLYLINE、CIRCLE、ELLIPSE、SPLINE、REGION

(defun c:areaobj (/ 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)
)
)
(setq ss1 nil)
(restore)
)

(defun c:areaobj (/ 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) 
    ) 
  ) 
  (setq ss1 nil) 
  (restore) 
)

下面是计算曲线面积的VLISP代码

[it618postdisplay>0]

(defun c:ObjectArea (/ en curve area)
(if (setq en (entsel))
(progn
(setq curve (vlax-ename->vla-object (car en)))
(if
(vl-catch-all-error-p
(setq
area (vl-catch-all-apply 'vlax-curve-getArea (list curve))
)
)
nil
area
)
)
)
)

[/it618postdisplay]

HLCAD · 发表于 2016-9-23 14:03:33

感谢楼主提供源码！

longer1000 · 发表于 2016-9-24 00:35:11

感谢楼主提供源码！

wuwei067 · 发表于 2016-9-26 15:38:29

不错··············

yoyoho · 发表于 2016-11-25 13:54:09

感谢楼主提供源码程序!!!!

ynhh · 发表于 2016-11-25 16:10:38

谢谢楼主啊谢谢楼主

sachindkini · 发表于 2016-11-25 17:30:34

see the hidden content

向嘟嘟 · 发表于 2016-11-29 18:50:45

正需要，支持楼主大人了！

dbx5151 · 发表于 2016-11-30 14:38:45

不错啊，谢谢分享！

sh_h · 发表于 2016-11-30 15:44:57

向高手学习！

xc3324689 · 发表于 2016-11-30 15:55:20

感谢楼主提供源码！

xc3324689 · 发表于 2016-11-30 15:59:23

感谢楼主提供源码

kukine · 发表于 2016-12-16 08:44:32

我来测试一下，行不行

qyming1996 · 发表于 2016-12-25 15:08:28

学习学习。。。。。。。。。。。。。。。。。

黄金铁蛋 · 发表于 2016-12-25 16:48:37

谢谢楼主的分享

账号		自动登录	找回密码
密码			立即注册

[每日一码] 计算批量对象的面积

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。