如何得到所选图元的最大外形?

rongyifei

       请问各位大侠我选择左边所示的图元(可能为多段线,也可能为单个的简单图元),通过Lisp如何得到右图红线所示的所选图元的最大外形?

armyzh

不能去掉内部的轮廓线啊，求优化

wen1235

我试了一下，应该可以得到，

我先将所有的图元炸开为单线，

再用"getboundingbox"取得所选图元集的包容框，

再以包容框的点外偏，作一矩形，也就是相当一个"回"字。

然后用下面的句子，就可以得到两个矩形,

你用过滤就可以得到你想要的图形了，

  (setq p1 (getpoint "\n>>>>>选择选择封闭图元内一点==>"))
  (command "bpoly" p1 "")

sailorcwx

3. ;得到最大外形 by weltion
4. (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)
5.   
6.   ;加载vlisp函数
7.   (vl-load-com)
8.   ;ACD应用程序
9.   (setq acadapp (vlax-get-acad-object)
10. ;当前文档
11. acaddoc (vla-get-activedocument acadapp)
12. )
13.   ;当前工作空间
14.   (if (= (getvar "TILEMODE") 1)(setq acadspc (vla-get-modelspace acaddoc))(setq acadspc (vla-get-paperspace acaddoc)))
15.   ;选择处理对象
16.   (if (setq sltset (ssget))
17.    
18.     (progn
19.       ;保存用户捕捉
20.       (setq osmode (getvar "OSMODE"))
21.       ;关闭捕捉
22.       (setvar "OSMODE" 0)
23.       ;获取当前时间
24.       (setq blname (rtos (getvar "CDATE")))
25.       ;制作成图块
26.       (command "block" blname '(0 0 0) sltset "")
27.       ;插入块
28.       (command "insert" blname '(0 0 0) 1 1 0)
29.       ;块图元名
30.       (setq blent (entlast)
31.             ;转成VLA对象
32.      blobj (vlax-ename->vla-object blent)
33.      )
34.       ;求块最大外框
35.       (vla-getboundingbox blobj 'lpt 'upt)
36.       ;转化外框坐标
37.       (setq lpt (vlax-safearray->list lpt)
38.      upt (vlax-safearray->list upt)
39.      ;屏幕距离
40.      dst (getvar "VIEWSIZE")
41.      
42.      )
43.       ;构造外框4个顶点坐标
44.       (setq pt1 lpt
45.      pt2 (list (car lpt) (cadr upt) 0)
46.      pt3 upt
47.      pt4 (list (car upt) (cadr lpt) 0)
48.      ;构造一个空的数组
49.      pt0 (vlax-make-safearray vlax-vbdouble '(0 . 11))
50.      )
51.       ;将4个顶点填充入数组
52.       (vlax-safearray-fill pt0 (append pt1 pt2 pt3 pt4))
53.       ;创建最大外框
54.       (setq bdobj (vla-addpolyline acadspc pt0))
55.       ;close it
56.       (vla-put-closed bdobj :vlax-true)
57.       ;向外偏移构造辅助边界线
58.       (setq hobj  (car (vlax-safearray->list (vlax-variant-value (vla-offset bdobj (* -2 dst)))))
59.      ;转化为图元名
60.      hent (vlax-vla-object->ename hobj)
61.      )
62.       ;求一个辅助点
63.       (setq hpt (polar lpt pi dst))
64.       ;获得最后一个图元
65.       (setq lent (entlast)
66.      maxarea nil
67.      maxobj nil
68.      )
69.       ;创造外形
70.       (command "boundary" "A" "B" "N" blent hent "" "" hpt "")
71.       ;找出面积最大的外形
72.       (while (setq lent (entnext lent))
73. (if (and (= (vla-get-objectname (setq obj (vlax-ename->vla-object lent))) "AcDbPolyline") (> (setq obja (vla-get-area obj)) maxarea))
74.    (setq maxarea obja maxobj obj)
75.    )
76. )
77.       ;删除辅助对象
78.       (vla-erase hobj)
79.       (vla-erase bdobj)
80.       (vla-erase maxobj)
81.       ;炸开块并清理块
82.       (command "explode" blent "purge" "B" blname "" "Y")
83.       ;恢复用户设置
84.       (setvar "OSMODE" osmode)
85.       
86.       )
87.     )
88.   ;good job
89.   (princ)
90.   
91.   )     
92.       
93.   

;得到最大外形 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)      )               

rongyifei

     谢谢楼上两位出手相助,我先去试试.明经上有这么多热心人士,一定会办得更好!

caoyin

得到数据后undo回去，而不要去炸开

这样的方法有时会产生孤岛的问题

carrot1983

没看懂。。。呵呵

给个自己的思路:

(command "._region"...

同样判断取得最大面积的面域后，删除其它。

最大面积的面域即最外轮廓

sailorcwx

论坛编译错误,把我的hent (vlax-vla-object->ename hobj)改成
hent (vla-object->ename.htm target=_black>vlax-vla-object->ename hobj)了

sailorcwx

CAD2008