[求助]：如何在打开AutoCAD2002时自动生成特定图层？

coldice000

本人刚学习VBA，有个问题想请教大家：我想在每一次打开AutoCAD软件的时候和每一次点击新建图纸的时候让它自动生成指定的几个图层，就像天河软件一样，如何才能达到这种效果？我会点VBA，想通过VBA来实现。

3kd

不用这么麻烦吧？只要在新建时使用模板文件就可以了呀

efan2000

一种方法是做在模板，保存为DWT格式的。
另一种编写一个创建图层的程序，打开AutoCAD时自动运行，以及在Document_New事情（新建文档时）中调用创建图层的程序。

coldice000

楼上：
   如何使自己的程序随AutoCAD自动运行呢？我只会点VBA，在ACAD.DVB中加载吗？好象是不能实现。Document_New事情（是AddNew事件吧）好象也行不通

efan2000

试了一下，在ACAD.DVB中的过程要等到VBA IDE启动之后才会运行。因而，最好放到Lisp中执行。
在Application的NewDrawing事件中，由于新文档刚创建时AutoCAD还没有创建层表，故不能其操作，需要一个延迟的操作，比如定时器来控制。

使用文档的激活事件来处理吧，对于新文档，创建之后就会自动触发这个事情。

2. 
   
3. ' 文档激活时触发的过程
   
4. Private Sub AcadDocument_Activate()
   
5.     Dim LayerObj As AcadLayer
   
6.     Dim bFound As Boolean
   
7.     ' 判断层是否存在
   
8.     For Each LayerObj In ThisDrawing.Layers
   
9.         If LayerObj.Name = "Test_CreateLayer" Then
   
10.             bFound = True
    
11.             Exit For
    
12.         End If
    
13.     Next
    
14.     Set LayerObj = Nothing
    
15.     If bFound = False Then ThisDrawing.Layers.Add "Test_CreateLayer"
    
16. End Sub
    

<br /> ' 文档激活时触发的过程<br /> Private Sub AcadDocument_Activate()<br />     Dim LayerObj As AcadLayer<br />     Dim bFound As Boolean<br />     ' 判断层是否存在<br />     For Each LayerObj In ThisDrawing.Layers<br />         If LayerObj.Name = "Test_CreateLayer" Then<br />             bFound = True<br />             Exit For<br />         End If<br />     Next<br />     Set LayerObj = Nothing<br />     If bFound = False Then ThisDrawing.Layers.Add "Test_CreateLayer"<br /> End Sub<br />

coldice000

楼上：
   我是想采取你说的办法，我也知道可以这么做，可惜自己不会Lisp，目前也没有Lisp的书籍。
   我有一个问题：能不能在AutoCAD的启动组中加入一个VBA工程文件呢，这样可以在启动AutoCAD时就初始化VBA？