[编程申请]：拷贝物体到当前层

doongs

拷贝物体到当前层
帮帮忙！

XDSoft

已经写过了，搜索下本论坛。

http://www.xdcad.net/forum/showthread.php?postid=72209#post72209

再贴一次吧。

该工具可以把一个层上的所有实体转移到另外一个层上，如果选输入层名，目标图层不存在新建。

2. 
   
3. [FONT=courier new]
   
4. (defun c:XDTB_LayerCopy (/ ss sLyr dLyr e)
   
5.   (if (xdrx_entsel "\n请选取要处理的一个层上的实体<退出>:")
   
6.     (progn
   
7.       (setq sLyr (xdrx_getentdxf 8))
   
8.       (xdrx_begin)
   
9.       (setq ss (ssget "x" (list (cons 8 sLyr))))
   
10.       (xdrx_Pickset_redraw ss)
    
11.       (if (xdrx_entsel "\n请选取目标图层上的实体<输入>:")
    
12.         (setq dLyr (xdrx_getentdxf 8))
    
13.         (progn
    
14.           (if (= "" (setq dLyr (getstring "\n请输入目标层名:")))
    
15.             (if (= 1 (xdrx_yesorno "\n是否使用当前层" 1))
    
16.               (setq dLyr (getvar "clayer"))
    
17.             (setq dLyr nil)
    
18.             )
    
19.           )
    
20.         )
    
21.       )
    
22.       (if dLyr
    
23.         (progn
    
24.           (xdrx_entity_setlayer ss dLyr)
    
25.           (prompt (strcat "\n已经成功的将图层"" sLyr
    
26.                           ""上的所有实体转换到图层"" dLyr """
    
27.                   )
    
28.           )
    
29.         )
    
30.       )
    
31.       (xdrx_Pickset_redraw ss t)
    
32.       (xdrx_end)
    
33.     )
    
34.   )
    
35.   (princ)
    
36. )[/FONT]

<br /> [FONT=courier new]<br /> (defun c:XDTB_LayerCopy (/ ss sLyr dLyr e)<br />   (if (xdrx_entsel "\n请选取要处理的一个层上的实体<退出>:")<br />     (progn<br />       (setq sLyr (xdrx_getentdxf 8))<br />       (xdrx_begin)<br />       (setq ss (ssget "x" (list (cons 8 sLyr))))<br />       (xdrx_Pickset_redraw ss)<br />       (if (xdrx_entsel "\n请选取目标图层上的实体<输入>:")<br />         (setq dLyr (xdrx_getentdxf 8))<br />         (progn<br />           (if (= "" (setq dLyr (getstring "\n请输入目标层名:")))<br />             (if (= 1 (xdrx_yesorno "\n是否使用当前层" 1))<br />               (setq dLyr (getvar "clayer"))<br />             (setq dLyr nil)<br />             )<br />           )<br />         )<br />       )<br />       (if dLyr<br />         (progn<br />           (xdrx_entity_setlayer ss dLyr)<br />           (prompt (strcat "\n已经成功的将图层"" sLyr<br />                           ""上的所有实体转换到图层"" dLyr """<br />                   )<br />           )<br />         )<br />       )<br />       (xdrx_Pickset_redraw ss t)<br />       (xdrx_end)<br />     )<br />   )<br />   (princ)<br /> )[/FONT]

doongs

这个帖子我已经下载试用过了，我现在的目的是想把多个不同层上的物体拷到了个层上，因为是做园林的，常常要把不同的灌木做成不同的填充形式，而且常常把这个不同的灌木放在不同的层上，以方便统计。当我们出别的图（如树平面布置）时，这些灌木又上做一种简略，都用一种填充方式代替，这样，我还得重新填充一遍（对于不规则的多义线的围成的图形做填充也是一个很麻烦而且很费时间的事，所以我想把不同层的填充烤到（不是移动）一个层上，位置也是不变的（这样就和原来的填充完全重合了），也只有当这两个完全重合的填充在不同的层上，我才能改动一个填充图案（组合成笼统的灌木层）

XDSoft

最初由 doongs 发布
[B]这个帖子我已经下载试用过了，我现在的目的是想把多个不同层上的物体拷到了个层上，因为是做园林的，常常要把不同的灌木做成不同的填充形式，而且常常把这个不同的灌木放在不同的层上，以方便统计。当我们出别的图（... [/B]

不想整个层实体都变，自己交互选择需要的实体，那么你去用“图层匹配”：

http://www.xdcad.net/forum/showthread.php?postid=72336#post72336

关于图层操作的，还有“图层合并”：

http://www.xdcad.net/forum/showthread.php?postid=73440#post73440

图层删除、图层孤立、孤立恢复...等等。这些工具组合，应该能满足大多数关于图层方面的需要了。

doongs

非常感谢！这里问题的回答速度让我惊讶！
不过上面那两样都不是我想要的东西，我要原本的复制一份到指定的层，原来实体的那个也要原样保留

XDSoft

最初由 doongs 发布
[B]非常感谢！这里问题的回答速度让我惊讶！
不过上面那两样都不是我想要的东西，我要原本的复制一份到指定的层，原来实体的那个也要原样保留 [/B]

你可以变通啊，工具可以组合的。

你先拷贝选择的实体，然后把这些实体在转换到指定层。

用工具箱的“标记”，可以很方便的获得拷贝后的实体选择集。再把这个选择集，应用到“图层转换”等程序上。

大家应该灵活使用ACAD的构筑选择集功能，灵活的去交给程序处理。

工具如果做的太细，那么应用反而不广泛。

conn

[program]; 复制到当前层（copy_to_layer）。
;本程序将复制一个实体到当前层。

(defun C:text ()
    (setvar "cmdecho" 0)
    (setq c_layer (getvar "clayer")
          sset (ssget)
          pt1 (getpoint "\n基点： ")
          count 0)
   (prompt "\n位移的第二点： ")
      (setq  len (sslength sset))
      (while (< count len)
       (setq name (ssname sset count)
             ptlst (entget name)
             b (assoc 8 ptlst)
             b1 (cdr (assoc 8 ptlst))
             c (cons 8 c_layer)
             d (subst c b ptlst)
             count (1+ count))
            (entmod d)
     )
    (command "_copy" sset "" pt1 pause)
    (setq count 0)
    (while (< count len)
    (setq name (ssname sset count)
             ptlst (entget name)
             b (assoc 8 ptlst)
             c (cons 8 b1)
             d (subst c b ptlst)
             count (1+ count))
            (entmod d)
     )
     (princ)
   )[/program]

snsj

最初由 conn 发布
[B]; 复制到当前层（copy_to_layer）。
;本程序将复制一个实体到当前层。

(defun C:text ()
    (setvar "cmdecho" 0)
    (setq c_layer (getvar "clayer")
          sset (ssget)
          pt1 (getpoint ... [/B]

简单一点，不用那么复杂，掌握好基本命令一样解决问题
[php]
(defun c:cs (/ ss)
(setvar "cmdecho" 1)
(command ".copybase" '(0 0)(setq ss(ssget)) "")
(command ".pasteclip" '(0 0))(command ".move" ss "" pause pause)
(command ".change" ss "" "p" "la" (getvar "clayer") "")
(princ)
  )
[/php]