[LISP程序]：快速多重拷贝对象

xiaping

用于快速多重拷贝对象的程序

YueFeng

这么短的程序，怎么不公开贴出来。还要提供下载。（嘿嘿，如果公开贴出来的话，会必现真是好简单）

LUCAS

就像这样吗?

2. 
   
3. (defun c:cc ()
   
4.   (command ".copy" (ssget) "" "m")
   
5.   (princ)
   
6.   )
   

<br /> (defun c:cc ()<br />   (command ".copy" (ssget) "" "m")<br />   (princ)<br />   )<br />

e2002

最初由 LUCAS 发布
[B]就像这样吗?

2. 
   
3. (defun c:cc ()
   
4.   (command ".copy" (ssget) "" "m")
   
5.   (princ)
   
6.   )
   

<br /> (defun c:cc ()<br />   (command ".copy" (ssget) "" "m")<br />   (princ)<br />   )<br />

[/B]

不会这样简单的...

梦断江南

最初由 xiaping 发布
[B]用于快速多重拷贝对象的程序 [/B]

上面的程序是

2. 
   
3. (defun c:dcopy (/ ent)
   
4.   (setq ent (ssget))
   
5.   (command "copy" ent "" "m")
   
6. )
   

<br /> (defun c:dcopy (/ ent)<br />   (setq ent (ssget))<br />   (command "copy" ent "" "m")<br /> )<br />

请朋友们以后发表帖子时注意：
如果文件较短，可直接贴出来（当然也可同时提供打包文件）
功能较复杂的最好提供使用说明/步骤。
有兴趣的还可提供编程构思，方便大家学习，讨论。

e2002

Multiple Copy可以说时最接近"原始社会"的老资格Lisp程序了...我不知道别的用户是否觉得标准Copy命令不默认Multiple很不方便?故而诞生了无数MultiCopy程序...

这个问题为何不会这么简单呢?因为编程者当然希望这个MultiCopy程序的"表现"尽可能接近标准Copy命令:能动态显示选择集.遗憾的是VL似乎不能实现(当然用Arx可以完美实现这样的Copy),故而只能使用command函数调用标准Copy命令.可是编程者无法决定程序的使用者何时不想继续Copy,要退出了,所以这个程序不能向别的VL程序那样,而只能调用一个"未结束"的Copy命令,即程序实际已经结束了,而调用的Copy命令还没有结束,正在等待用户交互输入呢...

在这样的前提下,要想不出错(如...Unknown command "M"...)我们在程序的实现中要注意:
1. 传递给command copy的选择集ss是否非空?
  

2. 
   
3.    (if (setq ss (ssget))
   
4.       .....
   
5.    )
   
6.    

<br />    (if (setq ss (ssget))<br />       .....<br />    )<br />    

2. 即使ss非空,也会有问题:当ss中的各图元"均"属于当前状态为"锁定"的图层上时,按上面的几个程序就会出现问题了...
   所以上面代码中的(setq ss (ssget))需要修改:
  

2. 
   
3.    (if (setq ss (ssget layerfilter-list))
   
4.       .....
   
5.    )
   
6.    

<br />    (if (setq ss (ssget layerfilter-list))<br />       .....<br />    )<br />    

   这里的layerfilter-list是那些当前Document中所有未锁定的图层过滤表
   layerfilter-list = (list (cons 8 sUnlockedLayerNames))
   sLayerNames是String,逗号分隔各图层名
   layerfilter-list 需要在if之前获得,这可以写一个通用子函数(还有很多用处的)实现.

   这样,我们通过图层过滤实现了不选中在锁定图层上的对象,现在再调用command就不会出错了...
   当然,记得basepoint也要非空哦...

  

2. 
   
3.    (defun ssget:FilterStringUnlockLayer ( / ...)
   
4.       .....
   
5.       .....
   
6.       .....
   
7.    );end defun ssget:FilterStringUnlockLayer
   
8. 
   
9.    (setq sSSFilter (ssget:FilterStringUnlockLayer)
   
10.          layerfilter-list (list (cons 8 sSSFilter))
    
11.    )
    
12.    (if (and (setq ss (ssget layerfilter-list))
    
13.             (setq basepoint (getpoint "\nBase point : "))
    
14.        )
    
15.      (command "_.copy" ss "" "_m" bpt)
    
16.    );endif
    
17.    

<br />    (defun ssget:FilterStringUnlockLayer ( / ...)<br />       .....<br />       .....<br />       .....<br />    );end defun ssget:FilterStringUnlockLayer <br /> <br />    (setq sSSFilter (ssget:FilterStringUnlockLayer)<br />          layerfilter-list (list (cons 8 sSSFilter))<br />    )<br />    (if (and (setq ss (ssget layerfilter-list))<br />             (setq basepoint (getpoint "\nBase point : "))<br />        )<br />      (command "_.copy" ss "" "_m" bpt)<br />    );endif<br />    

   
   
说了这么多,是想说我们要注意"LockedLayer"这个问题,否则程序中会遗留这些很....的bugs.
追求程序的完美......

li809

6楼的最后代码能用吗

yl_andrew

终于找到这个LSP可以在CAD2002下的探索者中运行了，非常感谢楼主，以前找到的多重复制LSP都是在CAD2002下面可以正常运行，但是到了探索者下面就不能使用了，现在用楼主的这个LSP在探索者下面也能使用了，再次感觉楼主

wxj000

如果允许，肯共享的内容最好不要收爱心币，因下载的内容不一定需要，而爱心币数量对某人很重要

qjcpj

高版本的copy本身就带多重拷贝功能。

xjlong547

是這樣嗎？

2. (defun c:rt ()
   
3. (setq sl (entlast))
   
4. (setq obj (ssget))
   
5. (if obj
   
6.   (progn
   
7.     (setq pt1 (getpoint "\nBase point:"))
   
8.     (if pt1
   
9.       (progn
   
10.         (command "copy" obj "" pt1 pt1)
    
11.         (setq s0 (ssadd))
    
12.         (while (entnext sl) (ssadd (setq sl (entnext sl)) s0))
    
13.         (setvar "CMDECHO" 1)
    
14.         (command "ROTATE" s0 "" pt1 "\")
    
15.       )
    
16.     )
    
17.   )
    
18. )
    
19. (princ)
    
20. )

(defun c:rt ()<br /> (setq sl (entlast))<br /> (setq obj (ssget))<br /> (if obj<br />   (progn<br />     (setq pt1 (getpoint "\nBase point:"))<br />     (if pt1<br />       (progn<br />         (command "copy" obj "" pt1 pt1)<br />         (setq s0 (ssadd))<br />         (while (entnext sl) (ssadd (setq sl (entnext sl)) s0))<br />         (setvar "CMDECHO" 1)<br />         (command "ROTATE" s0 "" pt1 "\")<br />       )<br />     )<br />   )<br /> )<br /> (princ)<br /> )

骆一风

其实我觉得CAD自带的多重复制就已经很好用了

weishi12

兄弟去看网络美女视频吧，美女实在太多了，我都看得爽死了。不是病毒，放心打开看！网址：http://mm.mmkao.com/?

KLDC

ET里的多重复制功能非常好用