批量框剪小程序源码（更新至V2.0.0）
本帖最后由 张和平 于 2013-4-28 01:11 编辑第⑥次更新(2013/04/28)========================================
最近工作很忙，一直都没有更新，趁加班结束更新一下。
这次采用了express tools的etrim函数，所以对圆柱和方柱都是适用的，对于狭长的矩形也能胜任。
但是，使用有前提，就是你必须先装了express tools.(未在未装express tools的机子上测试，大家可以测试一下。)
这个版本有很多有待改进，但是先扔个适用版吧，急用的同学可以拿去用。
注意：和上一版本不同，这一版本只提供选择剪切边所在图层，未提供选择被剪切图元所在图层，因此，在操作前请自行关闭或者锁定不想被剪切的图层。下一版本中应该会完善这个功能。
第⑤次更新(2013/03/27)========================================
增加了选择“剪切边对应图层和待剪切图元对应图层”的功能。
第④次更新=================================================
请教大神们，如何选取块里的pline线作为剪切边啊。。
选择的时候加上条件(0 . "LWPOLYLINE")的话就只能选择块外的pline了，而块里pline将随块一同被忽略了。
好是纠结的问题啊。
CAD自带的剪切命令是可以单独选择块里的某个图元的，这个是怎么实现的呀？
第③次更新=================================================
原理加入如下程序抑制一下就可以了。。。(setvar "cmdecho" 0)
第②次更新=================================================
回家之后又仔细看了一下，发现了问题的所在，解决后的源码详见2楼。问题发生的原因是，如下命令后(command ".trim" end "")
(repeat (setq n (sslength ss))
(command (list(ssname ss (setq n (1- n))) midp))
)CAD提示：选择要修剪的对象，或按住 Shift 键选择要延伸的对象，或 [投影(P)/边(E)/放弃(U)]:不知道是trim这个命令段写得不对还是其他原因，我的解决办法是加上了下面这行：(COMMAND "")模拟CAD中按一下空格或按一下enter或按一下ESC退出当前的状态。
但是，目前还存在的不足是，程序选择的是块之外的pline线，这些pline线可以是闭合的也可以是不闭合的，存在于块中的pline线则没有选中。
接下去就要解决这些个问题了。有知道的大神也请赐教一下哈。。。
第①次更新==以下内容为首发帖子标题为【这个框剪程序为什么不能批量？？？？】时的帖子正文2013.03.26==
今天拼编了一个框剪的小程序，源码如下：但是这个程序却不能实现批量，纳闷中。请各位大神帮忙看看，分析一下是什么原因。(defun C:TTR( / en end end_data pmin pmax minp maxp minx miny maxx maxy m n ss midp i)
(vl-load-com)
(princ "\n请选择闭合pline:")
(while(null(setq en (ssget'((0 . "LWPOLYLINE")))))); (70 . 1)
(setq i 0)
(repeat (setq m (sslength en))
;(setq end (ssname en (setq m (1- m))))
(setq end (ssname en i))
(setq end_data (entget end))
(ttrMin_Max)
(setq midp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pmin pmax)))
(setq ss (ssget "c" Pmin Pmax))
(ssdel end ss)
(command ".trim" end "")
(repeat (setq n (sslength ss))
(command (list (ssname ss (setq n (1- n))) midp))
)
(setq i (1+ i))
)
(COMMAND "")
(princ "完成！")
)
(defun ttrMin_Max()
(vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
(setq minp (vlax-safearray->list minp)
maxp (vlax-safearray->list maxp))
(setq minx (car minp)
maxx (car maxp)
miny (cadr minp)
maxy (cadr maxp))
(setq pmin (list minx miny)
pmax (list maxx maxy))
)
(princ "命令TTR")
上传个调用文件(*.dwg)以利探讨 已解决这个问题了，调整了【(COMMAND "")】这一行命令的位置，详见下面：(defun C:TTR( / en end end_data pmin pmax minp maxp minx miny maxx maxy m n ss midp i)
(vl-load-com)
(princ "\n请选择闭合pline:")
(while(null(setq en (ssget'((0 . "LWPOLYLINE")))))); (70 . 1)
(setq i 0)
(repeat (setq m (sslength en))
;(setq end (ssname en (setq m (1- m))))
(setq end (ssname en i))
(setq end_data (entget end))
(ttrMin_Max)
(setq midp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pmin pmax)))
(setq ss (ssget "c" Pmin Pmax))
(ssdel end ss)
(command ".trim" end "")
(repeat (setq n (sslength ss))
(command (list (ssname ss (setq n (1- n))) midp))
)
(COMMAND "")
(setq i (1+ i))
)
(princ "完成！")
)
(defun ttrMin_Max()
(vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
(setq minp (vlax-safearray->list minp)
maxp (vlax-safearray->list maxp))
(setq minx (car minp)
maxx (car maxp)
miny (cadr minp)
maxy (cadr maxp))
(setq pmin (list minx miny)
pmax (list maxx maxy))
)
(princ "命令TTR")
俺来学习学习。 smartstar 发表于 2013-3-26 21:15 static/image/common/back.gif
俺来学习学习。
俺是初手，俺是来学习的 好像还是不能以块内多义线为边界进行修剪 longer1000 发表于 2013-3-27 08:40 static/image/common/back.gif
好像还是不能以块内多义线为边界进行修剪
是的，正在愁这个问题呢。。。 本帖最后由 smartstar 于 2013-3-27 12:51 编辑
刚才试了一下2楼的程序，不尽人意！执行结果如下图所示：
左边是剪切前，右边是剪切后。
圆内修剪好像不支持！！ 最、终情况有点糊涂。。。