批量框剪小程序源码（更新至V2.0.0）

张和平

第⑥次更新(2013/04/28)========================================
最近工作很忙，一直都没有更新，趁加班结束更新一下。
这次采用了express tools的etrim函数，所以对圆柱和方柱都是适用的，对于狭长的矩形也能胜任。
但是，使用有前提，就是你必须先装了express tools.(未在未装express tools的机子上测试，大家可以测试一下。)
这个版本有很多有待改进，但是先扔个适用版吧，急用的同学可以拿去用。
注意：和上一版本不同，这一版本只提供选择剪切边所在图层，未提供选择被剪切图元所在图层，因此，在操作前请自行关闭或者锁定不想被剪切的图层。下一版本中应该会完善这个功能。


第⑤次更新(2013/03/27)========================================
增加了选择“剪切边对应图层和待剪切图元对应图层”的功能。

第④次更新=================================================
请教大神们，如何选取块里的pline线作为剪切边啊。。
选择的时候加上条件(0 . "LWPOLYLINE")的话就只能选择块外的pline了，而块里pline将随块一同被忽略了。
好是纠结的问题啊。
CAD自带的剪切命令是可以单独选择块里的某个图元的，这个是怎么实现的呀？
第③次更新=================================================   
原理加入如下程序抑制一下就可以了。。。

1. (setvar "cmdecho" 0)

复制代码

第②次更新=================================================
回家之后又仔细看了一下，发现了问题的所在，解决后的源码详见2楼。问题发生的原因是，如下命令后

2. (command ".trim" end "")
   
3.    (repeat (setq n (sslength ss))
   
4.      (command (list(ssname ss (setq n (1- n))) midp))
   
5.    )

(command ".trim" end "")<br />    (repeat (setq n (sslength ss))<br />      (command (list(ssname ss (setq n (1- n))) midp))<br />    )

CAD提示：

1. 选择要修剪的对象，或按住 Shift 键选择要延伸的对象，或 [投影(P)/边(E)/放弃(U)]:

复制代码

不知道是trim这个命令段写得不对还是其他原因，我的解决办法是加上了下面这行：

1. (COMMAND "")

复制代码

模拟CAD中按一下空格或按一下enter或按一下ESC退出当前的状态。
但是，目前还存在的不足是，程序选择的是块之外的pline线，这些pline线可以是闭合的也可以是不闭合的，存在于块中的pline线则没有选中。
接下去就要解决这些个问题了。有知道的大神也请赐教一下哈。。。
第①次更新==以下内容为首发帖子标题为【这个框剪程序为什么不能批量？？？？】时的帖子正文2013.03.26==
今天拼编了一个框剪的小程序，源码如下：但是这个程序却不能实现批量，纳闷中。请各位大神帮忙看看，分析一下是什么原因。

2. (defun C:TTR( / en end end_data pmin pmax minp maxp minx miny maxx maxy m n ss midp i)
   
3. (vl-load-com)
   
4. (princ "\n请选择闭合pline:")
   
5. (while(null(setq en (ssget  '((0 . "LWPOLYLINE")))))); (70 . 1)
   
6. (setq i 0)
   
7. (repeat (setq m (sslength en))
   
8.    ;(setq end (ssname en (setq m (1- m))))
   
9.    (setq end (ssname en i))
   
10.    (setq end_data (entget end))
    
11.    (ttrMin_Max)
    
12.    (setq midp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pmin pmax)))
    
13.    (setq ss (ssget "c" Pmin Pmax))
    
14.    (ssdel end ss)
    
15.    (command ".trim" end "")
    
16.    (repeat (setq n (sslength ss))
    
17.      (command (list (ssname ss (setq n (1- n))) midp))
    
18.    )
    
19.    (setq i (1+ i))
    
20. )
    
21. (COMMAND "")
    
22. (princ "完成！")
    
23. )
    
24. 
    
25. (defun ttrMin_Max()
    
26. (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
    
27. (setq minp (vlax-safearray->list minp)
    
28.        maxp (vlax-safearray->list maxp))
    
29. (setq minx (car minp)
    
30.        maxx (car maxp)
    
31.        miny (cadr minp)
    
32.        maxy (cadr maxp))
    
33. (setq pmin (list minx miny)
    
34.        pmax (list maxx maxy))
    
35. )
    
36. (princ "命令TTR")
    

(defun C:TTR( / en end end_data pmin pmax minp maxp minx miny maxx maxy m n ss midp i)<br /> (vl-load-com)<br /> (princ "\n请选择闭合pline:")<br /> (while(null(setq en (ssget  '((0 . "LWPOLYLINE")))))); (70 . 1)<br /> (setq i 0)<br /> (repeat (setq m (sslength en))<br />    ;(setq end (ssname en (setq m (1- m))))<br />    (setq end (ssname en i))<br />    (setq end_data (entget end))<br />    (ttrMin_Max)<br />    (setq midp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pmin pmax)))<br />    (setq ss (ssget "c" Pmin Pmax))<br />    (ssdel end ss)<br />    (command ".trim" end "")<br />    (repeat (setq n (sslength ss))<br />      (command (list (ssname ss (setq n (1- n))) midp))<br />    )<br />    (setq i (1+ i))<br /> )<br /> (COMMAND "")<br /> (princ "完成！")<br /> )<br /> <br /> (defun ttrMin_Max()<br /> (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)<br /> (setq minp (vlax-safearray->list minp)<br />        maxp (vlax-safearray->list maxp))<br /> (setq minx (car minp)<br />        maxx (car maxp)<br />        miny (cadr minp)<br />        maxy (cadr maxp))<br /> (setq pmin (list minx miny)<br />        pmax (list maxx maxy))<br /> )<br /> (princ "命令TTR")<br />

Andyhon

上传个调用文件(*.dwg)以利探讨

张和平

已解决这个问题了，调整了【(COMMAND "")】这一行命令的位置，详见下面：

2. (defun C:TTR( / en end end_data pmin pmax minp maxp minx miny maxx maxy m n ss midp i)
   
3. (vl-load-com)
   
4. (princ "\n请选择闭合pline:")
   
5. (while(null(setq en (ssget  '((0 . "LWPOLYLINE")))))); (70 . 1)
   
6. (setq i 0)
   
7. (repeat (setq m (sslength en))
   
8.    ;(setq end (ssname en (setq m (1- m))))
   
9.    (setq end (ssname en i))
   
10.    (setq end_data (entget end))
    
11.    (ttrMin_Max)
    
12.    (setq midp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pmin pmax)))
    
13.    (setq ss (ssget "c" Pmin Pmax))
    
14.    (ssdel end ss)
    
15.    (command ".trim" end "")
    
16.    (repeat (setq n (sslength ss))
    
17.      (command (list (ssname ss (setq n (1- n))) midp))
    
18.    )
    
19.    (COMMAND "")
    
20.    (setq i (1+ i))
    
21. )
    
22. 
    
23. (princ "完成！")
    
24. )
    
25. 
    
26. (defun ttrMin_Max()
    
27. (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
    
28. (setq minp (vlax-safearray->list minp)
    
29.        maxp (vlax-safearray->list maxp))
    
30. (setq minx (car minp)
    
31.        maxx (car maxp)
    
32.        miny (cadr minp)
    
33.        maxy (cadr maxp))
    
34. (setq pmin (list minx miny)
    
35.        pmax (list maxx maxy))
    
36. )
    
37. (princ "命令TTR")
    

(defun C:TTR( / en end end_data pmin pmax minp maxp minx miny maxx maxy m n ss midp i)<br /> (vl-load-com)<br /> (princ "\n请选择闭合pline:")<br /> (while(null(setq en (ssget  '((0 . "LWPOLYLINE")))))); (70 . 1)<br /> (setq i 0)<br /> (repeat (setq m (sslength en))<br />    ;(setq end (ssname en (setq m (1- m))))<br />    (setq end (ssname en i))<br />    (setq end_data (entget end))<br />    (ttrMin_Max)<br />    (setq midp (mapcar '* '(0.5 0.5 0.5) (mapcar '+ pmin pmax)))<br />    (setq ss (ssget "c" Pmin Pmax))<br />    (ssdel end ss)<br />    (command ".trim" end "")<br />    (repeat (setq n (sslength ss))<br />      (command (list (ssname ss (setq n (1- n))) midp))<br />    )<br />    (COMMAND "")<br />    (setq i (1+ i))<br /> )<br /> <br /> (princ "完成！")<br /> )<br /> <br /> (defun ttrMin_Max()<br /> (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)<br /> (setq minp (vlax-safearray->list minp)<br />        maxp (vlax-safearray->list maxp))<br /> (setq minx (car minp)<br />        maxx (car maxp)<br />        miny (cadr minp)<br />        maxy (cadr maxp))<br /> (setq pmin (list minx miny)<br />        pmax (list maxx maxy))<br /> )<br /> (princ "命令TTR")<br />

smartstar

俺来学习学习。

张和平

smartstar 发表于 2013-3-26 21:15
俺来学习学习。

俺是初手，俺是来学习的

longer1000

好像还是不能以块内多义线为边界进行修剪

张和平

longer1000 发表于 2013-3-27 08:40
好像还是不能以块内多义线为边界进行修剪

是的，正在愁这个问题呢。。。

smartstar

刚才试了一下2楼的程序，不尽人意！执行结果如下图所示：
左边是剪切前，右边是剪切后。

完整武器

圆内修剪好像不支持！！

跳跳虫

最、终情况有点糊涂。。。