如何得到所选图元的最大外形?
<p></p><p> 请问各位大侠我选择左边所示的图元(可能为多段线,也可能为单个的简单图元),通过Lisp如何得到右图红线所示的所选图元的最大外形?</p> 不能去掉内部的轮廓线啊，求优化<p>我试了一下，应该可以得到，</p><p>我先将所有的图元炸开为单线，</p><p>再用"getboundingbox"取得所选图元集的包容框，</p><p>再以包容框的点外偏，作一矩形，也就是相当一个"回"字。</p><p>然后用下面的句子，就可以得到两个矩形,</p><p>你用过滤就可以得到你想要的图形了，</p><p> (setq p1 (getpoint "\n>>>>>选择选择封闭图元内一点==>"))<br/> (command "bpoly" p1 "")</p>
;得到最大外形 by weltion
(defun c:getboundary(/ ACADAPP ACADDOC ACADSPC BDOBJ BLENT BLNAME BLOBJ DST HENT HOBJ HPT LENT LPT MAXAREA MAXOBJ OBJ OBJA OSMODE PT0 PT1 PT2 PT3 PT4 SLTSET UPT)
;加载vlisp函数
(vl-load-com)
;ACD应用程序
(setq acadapp (vlax-get-acad-object)
;当前文档
acaddoc (vla-get-activedocument acadapp)
)
;当前工作空间
(if (= (getvar "TILEMODE") 1)(setq acadspc (vla-get-modelspace acaddoc))(setq acadspc (vla-get-paperspace acaddoc)))
;选择处理对象
(if (setq sltset (ssget))
(progn
;保存用户捕捉
(setq osmode (getvar "OSMODE"))
;关闭捕捉
(setvar "OSMODE" 0)
;获取当前时间
(setq blname (rtos (getvar "CDATE")))
;制作成图块
(command "block" blname '(0 0 0) sltset "")
;插入块
(command "insert" blname '(0 0 0) 1 1 0)
;块图元名
(setq blent (entlast)
;转成VLA对象
blobj (vlax-ename->vla-object blent)
)
;求块最大外框
(vla-getboundingbox blobj 'lpt 'upt)
;转化外框坐标
(setq lpt (vlax-safearray->list lpt)
upt (vlax-safearray->list upt)
;屏幕距离
dst (getvar "VIEWSIZE")
)
;构造外框4个顶点坐标
(setq pt1 lpt
pt2 (list (car lpt) (cadr upt) 0)
pt3 upt
pt4 (list (car upt) (cadr lpt) 0)
;构造一个空的数组
pt0 (vlax-make-safearray vlax-vbdouble '(0 . 11))
)
;将4个顶点填充入数组
(vlax-safearray-fill pt0 (append pt1 pt2 pt3 pt4))
;创建最大外框
(setq bdobj (vla-addpolyline acadspc pt0))
;close it
(vla-put-closed bdobj :vlax-true)
;向外偏移构造辅助边界线
(setq hobj(car (vlax-safearray->list (vlax-variant-value (vla-offset bdobj (* -2 dst)))))
;转化为图元名
hent (vlax-vla-object->ename hobj)
)
;求一个辅助点
(setq hpt (polar lpt pi dst))
;获得最后一个图元
(setq lent (entlast)
maxarea nil
maxobj nil
)
;创造外形
(command "boundary" "A" "B" "N" blent hent "" "" hpt "")
;找出面积最大的外形
(while (setq lent (entnext lent))
(if (and (= (vla-get-objectname (setq obj (vlax-ename->vla-object lent))) "AcDbPolyline") (> (setq obja (vla-get-area obj)) maxarea))
(setq maxarea obja maxobj obj)
)
)
;删除辅助对象
(vla-erase hobj)
(vla-erase bdobj)
(vla-erase maxobj)
;炸开块并清理块
(command "explode" blent "purge" "B" blname "" "Y")
;恢复用户设置
(setvar "OSMODE" osmode)
)
)
;good job
(princ)
)
谢谢楼上两位出手相助,我先去试试.明经上有这么多热心人士,一定会办得更好! <p>得到数据后undo回去，而不要去炸开</p><p></p><p>这样的方法有时会产生孤岛的问题</p> <p>没看懂。。。呵呵</p><p>给个自己的思路:</p><p>(command "._region"... </p><p>同样判断取得最大面积的面域后，删除其它。</p><p>最大面积的面域即最外轮廓</p> <p>论坛编译错误,把我的hent <font color="#ff0000">(</font><a href="http://www.mjtd.com/object/autolisp/vlax-<font" color="blue"><font></font><font color="#0000ff">vlax-<font color="#0000ff">vla-object-</font>>ename</font></a> hobj<font color="#ff0000">)改成</font><br/>hent <font color="#ff0000">(</font><a href="http://www.mjtd.com/object/autolisp/vlax-<font" color="blue"><font color="#000000">vla-object-<font></font>>ename.htm target=_black></font><font color="#0000ff">vlax-<font color="#0000ff">vla-object-</font>>ename</font></a> hobj<font color="#ff0000">)了</font></p> <p>CAD2008</p><p></p>