每个图层单独保存成DWG

Lisphk

1. (defun c:lay2dwg ( / bor doc dwg idx lst sel ssc sso tmp typ val )
   
2.    (setq dwg (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)))
   
3.          doc (vla-get-activedocument (vlax-get-acad-object))
   
4.          ssc (vla-get-selectionsets doc)
   
5.          typ (vlax-make-safearray vlax-vbinteger '(0 . 1))
   
6.          val (vlax-make-safearray vlax-vbvariant '(0 . 1))
   
7.          tmp 0
   
8.    )
   
9.    (vlax-safearray-put-element typ 0）
   
10.    (vlax-safearray-put-element typ 1 410)
    
11.    (vlax-safearray-put-element val 1 "Model")
    
12.    (while
    
13.        (not
    
14.            (vl-catch-all-error-p
    
15.                (vl-catch-all-apply 'vla-item
    
16.                    (list ssc (strcat "lay2dwg" (itoa (setq tmp (1+ tmp)))))
    
17.                )
    
18.            )
    
19.        )
    
20.    )
    
21.    (setq sso (vla-add ssc (strcat "lay2dwg" (itoa tmp))))
    
22. 
    
23.    (if (setq sel (ssget "_X" '((8 . "BORDO") (410 . "Model"))))
    
24.        (progn
    
25.            (repeat (setq idx (sslength sel))
    
26.                (setq idx (1- idx)
    
27.                      lst (cons (vlax-ename->vla-object (ssname sel idx)) lst)
    
28.                )
    
29.            )
    
30.            (setq bor
    
31.                (vlax-make-variant
    
32.                    (vlax-safearray-fill
    
33.                        (vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))
    
34.                        lst
    
35.                    )
    
36.                )
    
37.            )
    
38.        )
    
39.    )
    
40. 
    
41.    (vlax-for lay (vla-get-layers doc)
    
42.        (if (/= "BORDO" (strcase (vla-get-name lay)))
    
43.            (progn
    
44.                (vlax-safearray-put-element val 0 (vla-get-name lay))
    
45.                (vla-clear  sso)
    
46.                (vla-select sso acselectionsetall nil nil (vlax-make-variant typ) (vlax-make-variant val))
    
47.                (if (< 0 (vla-get-count sso))
    
48.                    (progn
    
49.                        (if bor (vla-additems sso bor))
    
50.                        (vla-wblock doc (strcat dwg "_" (vla-get-name lay) ".dwg") sso)
    
51.                    )
    
52.                )
    
53.            )
    
54.        )
    
55.    )
    
56.    (vla-delete sso)
    
57.    (princ)
    
58. )
    

(defun c:lay2dwg ( / bor doc dwg idx lst sel ssc sso tmp typ val )<br />    (setq dwg (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)))<br />          doc (vla-get-activedocument (vlax-get-acad-object))<br />          ssc (vla-get-selectionsets doc)<br />          typ (vlax-make-safearray vlax-vbinteger '(0 . 1))<br />          val (vlax-make-safearray vlax-vbvariant '(0 . 1))<br />          tmp 0<br />    )<br />    (vlax-safearray-put-element typ 0）<br />    (vlax-safearray-put-element typ 1 410)<br />    (vlax-safearray-put-element val 1 "Model")<br />    (while<br />        (not<br />            (vl-catch-all-error-p<br />                (vl-catch-all-apply 'vla-item<br />                    (list ssc (strcat "lay2dwg" (itoa (setq tmp (1+ tmp)))))<br />                )<br />            )<br />        )<br />    )<br />    (setq sso (vla-add ssc (strcat "lay2dwg" (itoa tmp))))<br /> <br />    (if (setq sel (ssget "_X" '((8 . "BORDO") (410 . "Model"))))<br />        (progn<br />            (repeat (setq idx (sslength sel))<br />                (setq idx (1- idx)<br />                      lst (cons (vlax-ename->vla-object (ssname sel idx)) lst)<br />                )<br />            )<br />            (setq bor<br />                (vlax-make-variant<br />                    (vlax-safearray-fill<br />                        (vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst))))<br />                        lst<br />                    )<br />                )<br />            )<br />        )<br />    )<br /> <br />    (vlax-for lay (vla-get-layers doc)<br />        (if (/= "BORDO" (strcase (vla-get-name lay)))<br />            (progn<br />                (vlax-safearray-put-element val 0 (vla-get-name lay))<br />                (vla-clear  sso)<br />                (vla-select sso acselectionsetall nil nil (vlax-make-variant typ) (vlax-make-variant val))<br />                (if (< 0 (vla-get-count sso))<br />                    (progn<br />                        (if bor (vla-additems sso bor))<br />                        (vla-wblock doc (strcat dwg "_" (vla-get-name lay) ".dwg") sso)<br />                    )<br />                )<br />            )<br />        )<br />    )<br />    (vla-delete sso)<br />    (princ)<br /> )<br />

renyonghua2014

好，实用。学习楼主提供。

wzg980

看到vl系列就头晕，之前用的是COMMAND "WBLOCK".....

Livesay

学习代码如此重要，每天都不能落下

kqqt6236

可以再合并回来吗？

evayleung

谢谢分享。。。。。。。。。。。。。。。。。。。

kmliro_2017

谢谢分享！！！！！

279491611

雪中送炭，正需要。谢谢！

279491611

帮忙看看： 错误: 数组下标非法。？"图层名称没有特殊字符呢“
”

yoyoho

谢谢分享！！！！！！！！！！