批量图框加外框源码求完善！！！

fools

提供两种方法，第一种是通过矩形嵌套几何关系判断

2. ;;几何关系判断
   
3. (defun c:tt1 (/ box e i ss lst bound rects)
   
4.   (defun ebox (e / pa pb)
   
5.     (and (= 'ename (type e)) (setq e (vlax-ename->vla-object e)))
   
6.     (vlax-invoke-method e 'GetBoundingBox 'pa 'pb)
   
7.     (setq pa (trans (vlax-safearray->list pa) 0 1)
   
8.           pb (trans (vlax-safearray->list pb) 0 1)
   
9.     )
   
10.     (list pa pb)
    
11.   )
    
12.   (defun area (pts) (apply '* (cdr (reverse (apply 'mapcar (cons '- pts)))))) ;_求面积
    
13.   (defun pt4 (pt2)
    
14.     (list (car pt2) (list (caadr pt2) (cadar pt2)) (cadr pt2) (list (caar pt2) (cadadr pt2)))
    
15.   ) ;_对角点生成四角点
    
16.   (defun PtInPoly (pt pts)
    
17.     (equal pi
    
18.            (abs
    
19.              (apply '+ (mapcar '(lambda (x y) (rem (- (angle pt x) (angle pt y)) pi)) (cons (last pts) pts) pts))
    
20.            )
    
21.            1e-6
    
22.     )
    
23.   ) ;_点是否在凸多边形内（角度法）
    
24.   ;;
    
25.   (setq ss (ssget '((0 . "INSERT"))))
    
26.   (repeat (setq i (sslength ss))
    
27.     (setq e (ssname ss (setq i (1- i))))
    
28.     (setq lst (cons (ebox e) lst)) ;_提取边界对角点，不生产矩形
    
29.   )
    
30.   (setq lst (vl-sort lst '(lambda (x1 x2) (> (area x1) (area x2))))) ;_按面积大小排序
    
31.   (while lst
    
32.     (setq rects (cons (car lst) rects)) ;_矩形对角点集
    
33.     (setq bound (pt4 (car lst))) ;_矩形边界
    
34.     (setq lst (vl-remove-if '(lambda (x) (and (PtInPoly (car x) bound) (PtInPoly (cadr x) bound))) (cdr lst))) ;_移除大矩形边界内的小矩形
    
35.   )
    
36.   (mapcar '(lambda (x) (command-s "rectang" (car x) (cadr x))) rects) ;_批量生成矩形
    
37.   (princ)
    
38. )

;;几何关系判断<br /> (defun c:tt1 (/ box e i ss lst bound rects)<br />   (defun ebox (e / pa pb)<br />     (and (= 'ename (type e)) (setq e (vlax-ename->vla-object e)))<br />     (vlax-invoke-method e 'GetBoundingBox 'pa 'pb)<br />     (setq pa (trans (vlax-safearray->list pa) 0 1)<br />           pb (trans (vlax-safearray->list pb) 0 1)<br />     )<br />     (list pa pb)<br />   )<br />   (defun area (pts) (apply '* (cdr (reverse (apply 'mapcar (cons '- pts)))))) ;_求面积<br />   (defun pt4 (pt2)<br />     (list (car pt2) (list (caadr pt2) (cadar pt2)) (cadr pt2) (list (caar pt2) (cadadr pt2)))<br />   ) ;_对角点生成四角点<br />   (defun PtInPoly (pt pts)<br />     (equal pi<br />            (abs<br />              (apply '+ (mapcar '(lambda (x y) (rem (- (angle pt x) (angle pt y)) pi)) (cons (last pts) pts) pts))<br />            )<br />            1e-6<br />     )<br />   ) ;_点是否在凸多边形内（角度法）<br />   ;;<br />   (setq ss (ssget '((0 . "INSERT"))))<br />   (repeat (setq i (sslength ss))<br />     (setq e (ssname ss (setq i (1- i))))<br />     (setq lst (cons (ebox e) lst)) ;_提取边界对角点，不生产矩形<br />   )<br />   (setq lst (vl-sort lst '(lambda (x1 x2) (> (area x1) (area x2))))) ;_按面积大小排序<br />   (while lst<br />     (setq rects (cons (car lst) rects)) ;_矩形对角点集<br />     (setq bound (pt4 (car lst))) ;_矩形边界<br />     (setq lst (vl-remove-if '(lambda (x) (and (PtInPoly (car x) bound) (PtInPoly (cadr x) bound))) (cdr lst))) ;_移除大矩形边界内的小矩形<br />   )<br />   (mapcar '(lambda (x) (command-s "rectang" (car x) (cadr x))) rects) ;_批量生成矩形<br />   (princ)<br /> )

第二种方法是将所有矩形转换成面域后，再进行并集运算后，炸开重新生成矩形，源代码在附件中，收一点零花钱

依然小小鸟

fools 发表于 2018-12-19 16:17
提供两种方法，第一种是通过矩形嵌套几何关系判断

第二种方法是将所有矩形转换成面域后，再进行并集运算 ...

不知道可行不 你这是经过测试吧  要是可行 我就破费下载了

fools

依然小小鸟 发表于 2018-12-19 16:37
不知道可行不 你这是经过测试吧  要是可行 我就破费下载了

有多种方法可以实现你的需求，提供两种方法只是为了丰富解决问题的思路。
你如果画图规范的话，画一个大框，再用BOUNDARY命令一次性就能生成所有外框PLINE

依然小小鸟

fangmin723 发表于 2018-12-19 17:27
先点选要添加外框的块，然后在框选所有图元

亲测 此楼可以实现我想要的结果

依然小小鸟

fools 发表于 2018-12-19 16:17
提供两种方法，第一种是通过矩形嵌套几何关系判断

第二种方法是将所有矩形转换成面域后，再进行并集运算 ...

此楼也可以解决问题 而且此楼的通用性更强一些 即使图框不是图块也可以   好想也给你一些明经币

lg328084985

fools 发表于 2018-12-19 16:17
提供两种方法，第一种是通过矩形嵌套几何关系判断

第二种方法是将所有矩形转换成面域后，再进行并集运算 ...

谢谢老师的分享

softbird

fangmin723 发表于 2018-12-18 09:18
先点选要添加外框的块，然后在框选所有图元

点选的块名字有好多个，就需要操作好几次，能否在程序中指定处理某几个块名，分别对每个块操作一次，完成所有的块加外框？

fangmin723

softbird 发表于 2019-1-16 13:49
点选的块名字有好多个，就需要操作好几次，能否在程序中指定处理某几个块名，分别对每个块操作一次，完成 ...

可以啊，自己可以在我那个基础上进行修改！

softbird

fangmin723 发表于 2019-1-16 14:01
可以啊，自己可以在我那个基础上进行修改！

不会修改，能否麻烦你帮忙修改成A1、A2两个块名，然后我就会依样画葫芦了，谢谢

mokson

这个功能，平时都用得到，收藏了，谢谢楼主