框选对象生成外围圈

wowan1314

手机上网中！先说下我的思路！
1取所有实体各自包围盒！
2得到总包围盒！
3分别计算总包围盒四点与各自包围盒的交点（实交）最近点（横竖向各一点）！
4根据各个角点最近点压缩总包围盒！
5补齐包围盒。

wowan1314

不知道我说的思路是否是楼主想要的！
也可能是我把复杂的问题又想简单啦！
重在参与！呵呵

XDSoft

守仁格竹GM 发表于 2013-5-18 23:06
这是TT运行之后 我设置的 这几种情况的结果。现在应该是针对线或者多线段的最小外接矩形，而不是最小外接面 ...

应该是椭圆和SPLINE的包围盒就是这样的有关，希望能获得准确的，看牢固的了。

牢固

XDSoft 发表于 2013-5-18 23:27
应该是椭圆和SPLINE的包围盒就是这样的有关，希望能获得准确的，看牢固的了。

这个容易！已改好！

eachy

没有写完，提供一个思路，排序函数见另外帖子

1. (defun c:tt (/ getbox mkln ss sl i obj plst)
   
2.   ;;包围盒程序
   
3.   (defun getbox (e / bp up p1 p2)
   
4.     (vla-getboundingbox e 'bp 'up)
   
5.     (setq p1 (safearray-value bp)
   
6.    p2 (safearray-value up)
   
7.     )
   
8.     (list p1
   
9.    (list (car p2) (cadr p1) 0.)
   
10.    p2
    
11.    (list (car p1) (cadr p2) 0.)
    
12.     )
    
13.   )
    
14.   ;;绘制Line
    
15.   (defun mkln (p1 p2)
    
16.     (entmake (list '(0 . "LINE")
    
17.      '(100 . "AcDbEntity")
    
18.      '(100 . "AcDbLine")
    
19.      (cons 10 p1)
    
20.      (cons 11 p2)
    
21.       )
    
22.     )
    
23.   )
    
24.   ;;Main
    
25.   (if (setq ss (ssget))
    
26.     (progn
    
27.       (setq sl (sslength ss)
    
28.      i  -1
    
29.       )
    
30.       (repeat sl
    
31. (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
    
32. (if plst
    
33.    (setq plst (append (getbox obj) plst))
    
34.    (setq plst (getbox obj))
    
35. ) ;_包围盒点表
    
36.       )
    
37.       (setq ylst (mapcar 'cadr plst)
    
38.      miny (apply 'min ylst)
    
39.      maxy (apply 'max ylst) ;_Y 用来区分左右
    
40.      plst (ybl-ent-sort plst 0 4 0.0001) ;_排序函数
    
41.      p1  (caar plst) ;_列最下方点
    
42.      p2  (last (car plst)) ;_列最上方点,记录上一列
    
43.      ymin (cadr p1) ;_
    
44.      ymax (cadr p2) ;_记录上一竖线范围，用来控制横线
    
45.       )
    
46.       (mkln p1 p2) ;_最左侧竖线
    
47.       ;;扫描绘制右下方部分
    
48.       (while (< (cadr (last (car plst))) maxy)
    
49. (setq p3   (caar plst)
    
50.        p4   (last (car plst))
    
51.        plst (cdr plst)
    
52. )
    
53. (if (> (cadr p4) ymax) ;_做横线
    
54.    (progn
    
55.      (mkln p2 (list (car p4) (cadr p2) 0.))
    
56.      (mkln (list (car p4) (cadr p2) 0.) p4)
    
57.      (setq ymax (cadr p4)
    
58.     p2   p4
    
59.      )
    
60.    )
    
61. )
    
62. (if (< (cadr p3) ymin)
    
63.    (progn
    
64.      (mkln p1 (list (car p3) (cadr p1) 0.))
    
65.      (mkln p3 (list (car p3) (cadr p1) 0.))
    
66.      (setq ymin (cadr p3)
    
67.     p1   p3
    
68.      )
    
69.    )
    
70. )
    
71.       )
    
72.     )
    
73.   )
    
74.   (princ)
    
75. )

(defun c:tt (/ getbox mkln ss sl i obj plst)<br />   ;;包围盒程序<br />   (defun getbox (e / bp up p1 p2)<br />     (vla-getboundingbox e 'bp 'up)<br />     (setq p1 (safearray-value bp)<br />    p2 (safearray-value up)<br />     )<br />     (list p1<br />    (list (car p2) (cadr p1) 0.)<br />    p2<br />    (list (car p1) (cadr p2) 0.)<br />     )<br />   )<br />   ;;绘制Line<br />   (defun mkln (p1 p2)<br />     (entmake (list '(0 . "LINE")<br />      '(100 . "AcDbEntity")<br />      '(100 . "AcDbLine")<br />      (cons 10 p1)<br />      (cons 11 p2)<br />       )<br />     )<br />   )<br />   ;;Main<br />   (if (setq ss (ssget))<br />     (progn<br />       (setq sl (sslength ss)<br />      i  -1<br />       )<br />       (repeat sl<br /> (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))<br /> (if plst<br />    (setq plst (append (getbox obj) plst))<br />    (setq plst (getbox obj))<br /> ) ;_包围盒点表<br />       )<br />       (setq ylst (mapcar 'cadr plst)<br />      miny (apply 'min ylst)<br />      maxy (apply 'max ylst) ;_Y 用来区分左右<br />      plst (ybl-ent-sort plst 0 4 0.0001) ;_排序函数<br />      p1  (caar plst) ;_列最下方点<br />      p2  (last (car plst)) ;_列最上方点,记录上一列<br />      ymin (cadr p1) ;_<br />      ymax (cadr p2) ;_记录上一竖线范围，用来控制横线<br />       )<br />       (mkln p1 p2) ;_最左侧竖线<br />       ;;扫描绘制右下方部分 <br />       (while (< (cadr (last (car plst))) maxy)<br /> (setq p3   (caar plst)<br />        p4   (last (car plst))<br />        plst (cdr plst)<br /> )<br /> (if (> (cadr p4) ymax) ;_做横线<br />    (progn<br />      (mkln p2 (list (car p4) (cadr p2) 0.))<br />      (mkln (list (car p4) (cadr p2) 0.) p4)<br />      (setq ymax (cadr p4)<br />     p2   p4<br />      )<br />    )<br /> )<br /> (if (< (cadr p3) ymin)<br />    (progn<br />      (mkln p1 (list (car p3) (cadr p1) 0.))<br />      (mkln p3 (list (car p3) (cadr p1) 0.))<br />      (setq ymin (cadr p3)<br />     p1   p3<br />      )<br />    )<br /> )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

XDSoft

eachy 发表于 2013-5-19 00:15
没有写完，提供一个思路，排序函数见另外帖子

ea也来一个，写好后，贴个动画来论坛。

kwok

谢谢各位版主的帮助，关注!
刚才下了G版的代码，我用2013和2014试一下，怎么只提示找到12个对象，然后就什么也没了，退出了.
也没看到有外围线，跟G版的演示不一样，
是不是不支持2013？

eachy

完成,本算法用到的 ybl-ent-sort 函数，求得各个 Box 角点后用排序函数将点按行/列排序，这样就可以比较下一行/列和上一行/列的关系，收集比上一行/列 宽的点
关于 ybl-ent-sort 见 http://www.xdcad.net/forum/thread-668149-1-1.html

1. (defun c:tt (/ getbox mkpl drleft ss sl i obj plst ylst maxy miny plb
   
2.       plu pts)
   
3.   ;;包围盒程序
   
4.   (defun getbox (e / bp up p1 p2)
   
5.     (vla-getboundingbox e 'bp 'up)
   
6.     (setq p1 (safearray-value bp)
   
7.    p2 (safearray-value up)
   
8.     )
   
9.     (list p1
   
10.    (list (car p2) (cadr p1) 0.)
    
11.    p2
    
12.    (list (car p1) (cadr p2) 0.)
    
13.     )
    
14.   )
    
15.   ;;绘制PLine
    
16.   (defun mkpl (pts)
    
17.     (vla-put-closed
    
18.       (vlax-invoke
    
19. (vla-get-modelspace
    
20.    (vla-get-activedocument (vlax-get-acad-object))
    
21. )
    
22. 'AddLightWeightPolyline
    
23. (apply 'append
    
24.         (mapcar '(lambda (x)
    
25.      (list (float (car x)) ;_此处应为Double, INT会Fail
    
26.     (float (cadr x))
    
27.      )
    
28.    )
    
29.          pts
    
30.         )
    
31. )
    
32.       )
    
33.       :vlax-true
    
34.     )
    
35.   )
    
36.   ;;左半部分外框点
    
37.   (defun drleft (pts / p3 p4 tf tf1)
    
38.     (while (and pts (not (= tf tf1 T)))
    
39.       (setq p3 (caar pts)
    
40.      p4 (last (car pts))
    
41.      pts (cdr pts)
    
42.       )
    
43.       (if (> (cadr p4) (cadar plu)) ;_做横线
    
44. (setq plu (cons (list (car p4) (cadar plu) 0.) plu)
    
45.        plu (cons p4 plu)
    
46. )
    
47.       )
    
48.       (if (= (cadr p4) maxy)
    
49. (setq tf t)
    
50.       )
    
51.       (if (< (cadr p3) (cadar plb))
    
52. (setq plb (cons (list (car p3) (cadar plb) 0.) plb)
    
53.        plb (cons p3 plb)
    
54. )
    
55.       )
    
56.       (if (= (cadr p3) miny)
    
57. (setq tf1 t)
    
58.       )
    
59.     )
    
60.   )
    
61.   ;;Main
    
62.   (if (setq ss (ssget))
    
63.     (progn
    
64.       (setq sl (sslength ss)
    
65.      i  -1
    
66.       )
    
67.       (repeat sl
    
68. (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
    
69. (if plst
    
70.    (setq plst (append (getbox obj) plst))
    
71.    (setq plst (getbox obj))
    
72. ) ;_构造包围盒点表
    
73.       )
    
74.       ;;初始记录
    
75.       (setq ylst (mapcar 'cadr plst)
    
76.      miny (apply 'min ylst)
    
77.      maxy (apply 'max ylst) ;_Y 用来区分左右
    
78.      plst (ybl-ent-sort plst 0 4 0.0001) ;_排序函数
    
79.      plu  (list (last (car plst))) ;_左上部分点表
    
80.      plb  (list (caar plst)) ;_右下部分点表
    
81.       )
    
82.       (drleft (cdr plst))
    
83.       (setq pts  (append plu (reverse plb)) ;_收集左半边点
    
84.      plst (reverse plst) ;_倒过来处理右半边
    
85.      plu  (list (last (car plst)))
    
86.      plb  (list (caar plst))
    
87.       )
    
88.       (drleft (cdr plst))
    
89.       (mkpl (append pts plb (reverse plu)))
    
90.     )
    
91.   )
    
92.   (princ)
    
93. )

(defun c:tt (/ getbox mkpl drleft ss sl i obj plst ylst maxy miny plb<br />       plu pts)<br />   ;;包围盒程序<br />   (defun getbox (e / bp up p1 p2)<br />     (vla-getboundingbox e 'bp 'up)<br />     (setq p1 (safearray-value bp)<br />    p2 (safearray-value up)<br />     )<br />     (list p1<br />    (list (car p2) (cadr p1) 0.)<br />    p2<br />    (list (car p1) (cadr p2) 0.)<br />     )<br />   )<br />   ;;绘制PLine<br />   (defun mkpl (pts)<br />     (vla-put-closed<br />       (vlax-invoke<br /> (vla-get-modelspace<br />    (vla-get-activedocument (vlax-get-acad-object))<br /> )<br /> 'AddLightWeightPolyline<br /> (apply 'append<br />         (mapcar '(lambda (x)<br />      (list (float (car x)) ;_此处应为Double, INT会Fail<br />     (float (cadr x))<br />      )<br />    )<br />          pts<br />         )<br /> )<br />       )<br />       :vlax-true<br />     )<br />   )<br />   ;;左半部分外框点<br />   (defun drleft (pts / p3 p4 tf tf1)<br />     (while (and pts (not (= tf tf1 T)))<br />       (setq p3 (caar pts)<br />      p4 (last (car pts))<br />      pts (cdr pts)<br />       )<br />       (if (> (cadr p4) (cadar plu)) ;_做横线<br /> (setq plu (cons (list (car p4) (cadar plu) 0.) plu)<br />        plu (cons p4 plu)<br /> )<br />       )<br />       (if (= (cadr p4) maxy)<br /> (setq tf t)<br />       )<br />       (if (< (cadr p3) (cadar plb))<br /> (setq plb (cons (list (car p3) (cadar plb) 0.) plb)<br />        plb (cons p3 plb)<br /> )<br />       )<br />       (if (= (cadr p3) miny)<br /> (setq tf1 t)<br />       )<br />     )<br />   )<br />   ;;Main<br />   (if (setq ss (ssget))<br />     (progn<br />       (setq sl (sslength ss)<br />      i  -1<br />       )<br />       (repeat sl<br /> (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))<br /> (if plst<br />    (setq plst (append (getbox obj) plst))<br />    (setq plst (getbox obj))<br /> ) ;_构造包围盒点表<br />       )<br />       ;;初始记录<br />       (setq ylst (mapcar 'cadr plst)<br />      miny (apply 'min ylst)<br />      maxy (apply 'max ylst) ;_Y 用来区分左右<br />      plst (ybl-ent-sort plst 0 4 0.0001) ;_排序函数<br />      plu  (list (last (car plst))) ;_左上部分点表<br />      plb  (list (caar plst)) ;_右下部分点表<br />       )<br />       (drleft (cdr plst))<br />       (setq pts  (append plu (reverse plb)) ;_收集左半边点<br />      plst (reverse plst) ;_倒过来处理右半边<br />      plu  (list (last (car plst)))<br />      plb  (list (caar plst))<br />       )<br />       (drleft (cdr plst))<br />       (mkpl (append pts plb (reverse plu)))<br />     )<br />   )<br />   (princ)<br /> )

Lispboy

kwok 发表于 2013-5-19 01:29
谢谢各位版主的帮助，关注!
刚才下了G版的代码，我用2013和2014试一下，怎么只提示找到12个对象，然后就什 ...

在程序运行前，运行下

(vl-load-com)

kwok

Lispboy 发表于 2013-5-19 12:10
在程序运行前，运行下

(vl-load-com)

谢谢，忘了加这个，没留呢，

Lispboy

牢固 发表于 2013-5-18 23:48
这个容易！已改好！

2008下

1、这个图片出错，选园和椭圆，只给园画个框。
2、如果带上SPLINE，那么没结果。

Lispboy

同样，测试EACHY大师的，结果正确

cxjzxf

好贴，一定要支持一个。

牢固

Lispboy 发表于 2013-5-19 12:19
同样，测试EACHY大师的，结果正确

我怎么测试就没有问题呢？

把你的样图发上来我看看！

Lispboy

牢固 发表于 2013-5-19 13:31
我怎么测试就没有问题呢？

把你的样图发上来我看看！

G版，图应该不复杂啊，我是在2008下测试的，你也是吗？