框选对象生成外围圈

kwok · 发表于 2013-5-18 14:19:02

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 kwok 于 2013-5-19 18:41 编辑

更新了一下图,如下图，想框选所有白线的对象，产生一个红线的外围线，谢谢
求lisp

测试图:

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:test.zip
下载次数:169 文件大小:43.1 KB
下载权限: 不限以上 [免费赚D豆]

Lispboy · 发表于 2013-5-19 12:10:06

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

在程序运行前，运行下

(vl-load-com)

eachy · 发表于 2013-5-19 07:08:19

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

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

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

XDSoft · 发表于 2013-5-18 14:20:06

贴上测试的DWG图吧。程序能否实现和你这些内容的布局有关，把可能的形状组合多放几个在图里面，贴图也补充下。

XDSoft · 发表于 2013-5-18 14:23:02

你把eachy的实体排序给弄成具体应用了。

XDSoft · 发表于 2013-5-18 14:39:58

你这问题先是和在LISP论坛讨论，我给你移动过去了。楼主有什么初步的想法和思路，先发帖引导大家交流吧。

Lispboy · 发表于 2013-5-18 14:44:06

这题目，生成每个实体的盒子是必须的，关键是找出哪些盒子是外围的。有想法在跟帖。

kwok · 发表于 2013-5-18 14:44:20

有前辈指点用vla-GetBoundingBox得到每个对象的外圈，然后减掉那些角，一系列点排序。
但弄不出来，
看看高手有没有更简单的方法，求指导...

Lispboy · 发表于 2013-5-18 15:13:50

kwok 发表于 2013-5-18 14:44
有前辈指点用vla-GetBoundingBox得到每个对象的外圈，然后减掉那些角，一系列点排序。
但弄不出来，
看看 ...

楼主，左下角位置，这种情况，你不需要边界是黄色线那样？什么时候进去，什么时候不进去，能说个规则吗？

kwok · 发表于 2013-5-18 15:21:11

Lispboy 发表于 2013-5-18 15:13
楼主，左下角位置，这种情况，你不需要边界是黄色线那样？什么时候进去，什么时候不进去，能说个规 ...

这个黄色线位的我想是距离小于一定距离就怱略吧,如小于15cm,这个值可以设最好.

Lispboy · 发表于 2013-5-18 15:27:15

kwok 发表于 2013-5-18 15:21
这个黄色线位的我想是距离小于一定距离就怱略吧,如小于15cm,这个值可以设最好.

是不是复杂了？这是我想起来的一种情况，还可能有未知的，ACAD画图其实在程序处理前，还是需要用户有好的习惯，组织好数据的，比如需要处理的实体添加下扩展实体数据，归档到指定的图层什么的，便于快速找到要处理的图形。

你看你这个问题，是不是应该先交互下，让用户选择下哪些是最外面的实体，然后在用程序处理更好？

kwok · 发表于 2013-5-18 15:31:02

Lispboy 发表于 2013-5-18 15:27
是不是复杂了？这是我想起来的一种情况，还可能有未知的，ACAD画图其实在程序处理前，还是需要用户有好的 ...

对对，我没想到，应是以选中最外面的实体来生成外圈,怱略里面的那些图元，本来就是想要最外的那个线框
:)

牢固 · 发表于 2013-5-18 22:20:10

本帖最后由牢固于 2016-5-7 16:40 编辑

登录/注册后可看大图

游客，本帖隐藏的内容需要积分高于 100 才可浏览，您当前积分为 0

XDSoft · 发表于 2013-5-18 22:30:00

G版，Q群不发言，闷声做功课呢啊，效率。

和大家讲讲程序的思路，关键的算法啊{:soso_e113:}

守仁格竹GM · 发表于 2013-5-18 22:42:11

高手中的高手 G版

牢固 · 发表于 2013-5-18 23:02:39

XDSoft 发表于 2013-5-18 22:30
G版，Q群不发言，闷声做功课呢啊，效率。

和大家讲讲程序的思路，关键的算法啊

程序的思路如下：
1、计算选到的每个对象包围框四个角点坐表组成点表pl
2、处理点表pl，将x坐标相同的点各分组，并只保留Y值最大和最小的点组成点对,在图上画出竖线，再将Y坐标相同的点各分组，并只保留X值最大和最小的点组成点对,在图上画出水平线，所有画的线组成选择集SS
3、将选择集SS中的每条线用extend命令对SS进行延伸，这个过程可以多做几次，我的代码只做了两次，根据所选的图形的复杂程度，延伸不同次数可能结果不尽相同！
3、在物体外画一个大框，用boundary生成边界，生成的边界对象中保留面积第二大的边界（就是所要的结果），其余的删除，然后再删除线SS
任务完成！

守仁格竹GM · 发表于 2013-5-18 23:06:15

这是TT运行之后我设置的这几种情况的结果。现在应该是针对线或者多线段的最小外接矩形，而不是最小外接面积矩形

账号		自动登录	找回密码
密码			立即注册

[求助] 框选对象生成外围圈

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

评分

点评

评分

点评

评分

点评

评分

浏览过的版块