[求助]面积计算LSP
<p>要求框选图形，能自动计算出图示阴影区域面积。请各位大侠出手相助。谢谢。</p> <p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">其内半圆未闭合是常态吗?</font></p><p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">若其内皆是闭合图形,编程简易多多<br/></font></p>
<p> </p> Andyhon发表于2010-7-22 11:09:00static/image/common/back.gif其内半圆未闭合是常态吗?
若其内皆是闭合图形,编程简易多多
<p>内部全部是闭合图形。麻烦您给帮忙编个程序。谢谢啊。</p> <p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">;;; by Michael Puckett<br/>(defun cdrs (key lst / pair rtn)<br/> (while (setq pair (assoc key lst))<br/> (setq lst (cdr (member pair lst))<br/> rtn (cons (cdr pair) rtn)<br/> ) )<br/> ;; (reverse rtn)<br/> RTN<br/>)</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">(defun Oarea (x)<br/> (vla-get-area (vlax-ename->vla-object x))<br/>)</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">;;; For test only<br/>(vl-load-com)<br/>(defun C:AreaQ ()<br/> (setq ee (entsel "\n请选取外框: ")<br/> ee (car ee)<br/> pts (cdrs 10 (entget ee))<br/> ss (ssget "WP" pts)<br/> )</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana"> (print<br/> (-<br/> (Oarea ee)<br/> ;; (apply '+ (mapcar 'Oarea (sslist ss)))<br/> (apply '+ (mapcar 'Oarea (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))<br/> ) <br/> )<br/> (princ)<br/>)</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">=================================<br/>;; 依所附文件 删去半圆调试</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">Command: areaq</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">请选取外框:<br/>90300.0</font></p>
<p> </p>
<p>---------------------</p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">请先用 Pedit 处理闭合<br/></font></p> Andyhon发表于2010-7-22 12:08:00static/image/common/back.gif;;; by Michael Puckett(defun cdrs (key lst / pair rtn) (while (setq pair (assoc key lst)) (setq lst (cdr (member pair lst)) &n
<p> </p>
<p> </p>
<p>按您的程序运行，OK，您非常历害。不过有二个地方看看能不能修改一下，1、如果外框里面没有图形和外框是圆形时，运行程序时就显示参数错误，能不能改成只有一个外框和外框是圆时也能计算出面积？2、计算结果能不能改成对话框窗口弹出？谢谢。</p> <p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">代码已更新如附件</font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana"> </font></p>
<p><font style="BACKGROUND-COLOR: #ffffff" face="Verdana">请将所得利益回馈于灾民<br/></font></p> Andyhon发表于2010-7-22 15:12:00static/image/common/back.gif代码已更新如附件
请将所得利益回馈于灾民
areaq.rar
下载需付 0 个明经币
文件大小:.65 KB，下载次数:2
请使用WinRAR软件打开RAR压缩文件。
<p>衷心的说一句，非常感谢！</p> 改这一段
(setq ss (ssget "WP" pts))
(ssdel ee ss)
(setq str
(rtos
(-
(Oarea ee)
;; (apply '+ (mapcar 'Oarea (sslist ss)))
(apply '+ (mapcar 'Oarea (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
)
2
(getvar "Luprec")
) )
(alert str)
(dos_clipboard Str) ; 将结果复制到剪贴板中...
(princ)
相映的 Doslib 下载
http://www.en.na.mcneel.com/doslib.htm
不错，很好 <p>学习了，非常感谢</p>
页:
[1]
2