[LISP函数]：[分享]層復製

spring1983

2. ;;;程序名稱: 層復制___________________________________
   
3. ;;;程序提供: 龍龍仔大俠&前生版主 _____________________
   
4. ;;;程序修改: Spring___________________________________
   
5. ;;;2003.06.05_________________________________________
   
6. (defun ai_error        (errmsg)
   
7.   (if errmsg
   
8.     '("console break"
   
9.       "Function Cancelled"
   
10.      )
    
11.     (princ (strcat "\nError: " errmsg))
    
12.   )
    
13.   (princ)
    
14. ) ;_defun
    
15. (defun C:LCO (/ ss lay count en ed)
    
16.   (setq cm (getvar "cmdecho"))
    
17.   (setq        old_error *error*)               
    
18.   (setq  *error* ai_error)       
    
19.   (setvar "cmdecho" 0)
    
20.   (setq ss (ssget))
    
21.   (if ss
    
22.     (progn
    
23.       (setq lay T)
    
24.       (while (/= lay "")
    
25.         (setq lay (getstring "\n請輸入層名 / <ENTER結束命令>: "))
    
26.         (if (and (/= "" lay) (tblsearch "LAYER" lay))
    
27.           (progn
    
28.             (setq count 0)
    
29.             (while (< count (sslength ss))
    
30.               (setq en (ssname ss count))
    
31.               (setq count (1+ count))
    
32.               (setq ed (entget en))
    
33.               (setq ed (subst (cons 8 lay) (Assoc 8 ed) ed))
    
34.               (entmake ed)
    
35.             )
    
36.             (prompt
    
37.               (strcat "\n"
    
38.                       (itoa (sslength SS))
    
39.                       " 物件拷貝到 "
    
40.                       lay
    
41.                       " 層 "
    
42.               )
    
43.             )
    
44.           )
    
45.           (prompt
    
46.             (strcat "\n輸入的圖層名稱不存在! layer name=" lay " ")
    
47.           )
    
48.         )
    
49.       )
    
50.     )
    
51.   )
    
52.   (setq count nil)
    
53.   (setvar "cmdecho" cm)
    
54.   (setq *error* old_error)
    
55.   (princ)
    
56. )
    
57. ;;;________________________________________________________________________

;;;程序名稱: 層復制___________________________________<br /> ;;;程序提供: 龍龍仔大俠&前生版主 _____________________<br /> ;;;程序修改: Spring___________________________________<br /> ;;;2003.06.05_________________________________________<br /> (defun ai_error        (errmsg)<br />   (if errmsg<br />     '("console break"<br />       "Function Cancelled"<br />      )<br />     (princ (strcat "\nError: " errmsg))<br />   )<br />   (princ)<br /> ) ;_defun <br /> (defun C:LCO (/ ss lay count en ed)<br />   (setq cm (getvar "cmdecho"))<br />   (setq        old_error *error*)                <br />   (setq  *error* ai_error)        <br />   (setvar "cmdecho" 0)<br />   (setq ss (ssget))<br />   (if ss<br />     (progn<br />       (setq lay T)<br />       (while (/= lay "")<br />         (setq lay (getstring "\n請輸入層名 / <ENTER結束命令>: "))<br />         (if (and (/= "" lay) (tblsearch "LAYER" lay))<br />           (progn<br />             (setq count 0)<br />             (while (< count (sslength ss))<br />               (setq en (ssname ss count))<br />               (setq count (1+ count))<br />               (setq ed (entget en))<br />               (setq ed (subst (cons 8 lay) (Assoc 8 ed) ed))<br />               (entmake ed)<br />             )<br />             (prompt<br />               (strcat "\n"<br />                       (itoa (sslength SS))<br />                       " 物件拷貝到 "<br />                       lay<br />                       " 層 "<br />               )<br />             )<br />           )<br />           (prompt<br />             (strcat "\n輸入的圖層名稱不存在! layer name=" lay " ")<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (setq count nil)<br />   (setvar "cmdecho" cm)<br />   (setq *error* old_error)<br />   (princ)<br /> )<br /> ;;;________________________________________________________________________

taner

这程序太一般了，请去明经通道看看。

无痕

不要打击积极性么.
我觉得程序结构还是挺完整的.考虑了异常退出.如果能在选层的时候可以考虑通过物体选取,操作性可能会强些.

taner

(defun C:lc (/ layr a)
  (command "undo" "be")
  (setq layr (getstring "\nEnter target layer name: "))
  (setq a (ssget))
  (command "layer" "n" layr "")
  (command "copy" a "" "@" "@")
  (command "chprop" a "" "la" layr "")
  (command "undo" "e")
)

LUCAS

这个好像不是出自我手,是前生兄的，程序中使用entmake对尺寸对象可能会有非预期效果(尺寸对象受很多系统变量影响)。

spring1983

最初由 taner 发布
[B]这程序太一般了，请去明经通道看看。 [/B]

这個程序是比較一般,不過我覺得這個程序還是有一定的用處,所以就貼了出來

无痕

技巧:如果通过输入目标层名来改层,还不如
选择好物体后,在cad图层按钮中直接选取目标层也可(如图所示)

以下lsp是通过选图上目标实体来定目标层

2. 
   
3.   [FONT=courier new]
   
4. ;copy layer entities to another layer
   
5. ;layer copy
   
6. (defun c:lac (/ ss nm e la)
   
7. (print "<拷贝到另一层> obj:")(setq ss(ssget))
   
8. (setq nm (car (entsel "\n target objects for new layer:"))
   
9.         e (entget nm)
   
10.        la (cdr (assoc 8 e))
    
11. )
    
12. (command "copy" ss "" "0,0" "0,0" "change" ss "" "p" "la" la "")
    
13. )
    
14. 
    
15.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;copy layer entities to another layer<br /> ;layer copy<br /> (defun c:lac (/ ss nm e la)<br /> (print "<拷贝到另一层> obj:")(setq ss(ssget))<br /> (setq nm (car (entsel "\n target objects for new layer:"))<br />         e (entget nm)<br />        la (cdr (assoc 8 e))<br /> )<br /> (command "copy" ss "" "0,0" "0,0" "change" ss "" "p" "la" la "")<br /> )<br /> <br />   [/FONT]<br />

无痕

2
技巧:如果通过输入目标层名来改层,还不如
选择好物体后,在cad图层按钮中直接选取目标层也可(如图所示)

无痕

3
技巧:如果通过输入目标层名来改层,还不如
选择好物体后,在cad图层按钮中直接选取目标层也可(如图所示)

无痕

4 技巧:如果通过输入目标层名来改层,还不如
选择好物体后,在cad图层按钮中直接选取目标层也可(如图所示)

同理

taner

如果这个层不存在的话，"LC"则会新建一个层，并将所选原地COPY TO 新层上.

li809

7楼的好用些