由打开DWG复制实体到一个新图兼谈某些特殊图形处理

st788796

有些拿来的图形由于代理图形的存在，会出现 ctrl+c 和 wblock 无法执行，还有一些“加密”图形，把基本对象都修改成了自定义形式，无法编辑、复制等等（仅限于没有到丧心病狂地步）,这时候可以采取一个特殊方法实现“复制”实体。
现在的Autocad是支持多文档的，而且可以用 ActiveX 实现相互访问，

2. 
   
3. (setq docs (vla-get-documents (vlax-get-acad-object)))
   

<br /> (setq docs (vla-get-documents (vlax-get-acad-object)))<br />

通过 docs 的 item 方法就可以访问其它打开 dwg，假定先打开一个“有问题”的 dwg 文档（以下简称为源文档），然后新建一个空文档（以下简称当前文档），切换到当前文档，用下面的代码访问源文档

2. 
   
3. (setq doc (vla-item docs 0))
   

<br /> (setq doc (vla-item docs 0))<br />

当前文档就是

2. 
   
3. (setq curdoc (vla-get-activedocument (vlax-get-acad-object)))
   

<br /> (setq curdoc (vla-get-activedocument (vlax-get-acad-object)))<br />

从源文档的模型空间复制所有 line ，只考虑几何特征

2. 
   
3. (setq cms (vla-get-modelspace curdoc))
   
4. (vlax-for obj (vla-get-modelspace doc)
   
5.    (if (eq (vla-get-objectname obj) "AcDbLine")
   
6.       (vla-addline cms (vla-get-startpoint obj) (vla-get-endpoint obj))
   
7.    )
   
8. )
   

<br /> (setq cms (vla-get-modelspace curdoc))<br /> (vlax-for obj (vla-get-modelspace doc)<br />    (if (eq (vla-get-objectname obj) "AcDbLine")<br />       (vla-addline cms (vla-get-startpoint obj) (vla-get-endpoint obj))<br />    )<br /> )<br />

对于“加密”dwg，只要它提供了 ActiveX 方法，而且是继承自 AcDbLine，就可以用上述方法，只是objectname可能是另外名称

同理，想要保持 Layer Linetype 可以先行遍历源文档 layers 和 linetypes 复制到当前文档，复制的实质就是重写 vla-add 及 vla-addxxx 方法，这些方法仅用了实体的基本特征！

st788796

下面两个是复制线形和图层doc 源文档
obj 当前文档对应的集合

2. 
   
3. (defun copyltype (doc / lst)
   
4.     (vlax-for lt (vla-get-linetypes doc)
   
5.       (setq lst        (vl-remove-if
   
6.                   '(lambda (x) (member (car x) '(-1 330 5)))
   
7.                   (entget (vlax-vla-object->ename lt))
   
8.                 )
   
9.       )
   
10.       (entmakex lst)
    
11.     )
    
12.   )
    
13.   (defun copylayers (doc obj / clyr)
    
14.     (vlax-for lyr (vla-get-layers doc)
    
15.       (if (not (tblsearch "layer" (vla-get-name lyr)))
    
16.         (progn
    
17.           (setq clyr (vla-add obj (vla-get-name lyr)))
    
18.           (vla-put-color clyr (vla-get-color lyr))
    
19.           (if (tblsearch "ltype" (vla-get-linetype lyr))
    
20.             (vla-put-linetype clyr (vla-get-linetype lyr))
    
21.           )
    
22.         )
    
23.       )
    
24.     )
    
25.   )

<br /> (defun copyltype (doc / lst)<br />     (vlax-for lt (vla-get-linetypes doc)<br />       (setq lst        (vl-remove-if<br />                   '(lambda (x) (member (car x) '(-1 330 5)))<br />                   (entget (vlax-vla-object->ename lt))<br />                 )<br />       )<br />       (entmakex lst)<br />     )<br />   )<br />   (defun copylayers (doc obj / clyr)<br />     (vlax-for lyr (vla-get-layers doc)<br />       (if (not (tblsearch "layer" (vla-get-name lyr)))<br />         (progn<br />           (setq clyr (vla-add obj (vla-get-name lyr)))<br />           (vla-put-color clyr (vla-get-color lyr))<br />           (if (tblsearch "ltype" (vla-get-linetype lyr))<br />             (vla-put-linetype clyr (vla-get-linetype lyr))<br />           )<br />         )<br />       )<br />     )<br />   )

yangjian001

复制线形和图层doc 源

kqqt6236

学习，收藏了。

sh_h

感谢大师分享！！！