AutoCAD VBA判断指定图层是否存在,如不存在则新建.

泉(Ango)

请教各位，
        怎样在AutoCAD 里编写vab程序，判断指定图层（如：HAT）是否存在,如不存在则新建该图层（HAT）.
请教这样的VBA程序是怎样写的。
Thanks.

泉(Ango)

还有，新建新建该图层（HAT）时，怎样定义其颜色及线型？
情况是这样的：
    以下是我在网上找的程序，用于标注时自动切换到标注图层（如：Dim）。
但其前提是要有Dim图层存在的情况下，
现我想在程序中自带判断程序，判断是否有Dim 图层，如果没有，则自动生成Dim图层。有请你帮我补上这一程序。
程序如下：
Option Explicit
Dim oldLayer As AcadLayer
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
Debug.Print CommandName
Select Case CommandName
Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"
    Set oldLayer = ThisDrawing.ActiveLayer
    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")
End Select
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
Select Case CommandName
Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"
    ThisDrawing.ActiveLayer = oldLayer
End Select
End Sub
以上代码为在没有其它插件的情况下， "Dim"已经存在的情况下 。
请问怎样在代码里判断并创建此图层？？
谢谢！

Flyingdancing

找到对象模型（VBA界面随便输入一个CAD图元专属，譬如circle。按F1，转到帮助第一项）
application——document——layers——layer——你需要的设置项
父子关系，找子先找父，慢慢看吧，解说附带例子（example点进去）

泉(Ango)

Flyingdancing 发表于 2012-11-11 11:03
找到对象模型（VBA界面随便输入一个CAD图元专属，譬如circle。按F1，转到帮助第一项）
application——doc ...

情况是这样的：

    以下是我在网上找的程序，用于标注时自动切换到标注图层（如：Dim）。
但其前提是要有Dim图层存在的情况下，

现我想在程序中自带判断程序，判断是否有Dim 图层，如果没有，则自动生成Dim图层。有请你帮我补上这一程序。
程序如下：
Option Explicit
Dim oldLayer As AcadLayer
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
Debug.Print CommandName
Select Case CommandName
Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"
    Set oldLayer = ThisDrawing.ActiveLayer
    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")
End Select
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
Select Case CommandName
Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"
    ThisDrawing.ActiveLayer = oldLayer
End Select
End Sub
以上代码为在没有其它插件的情况下， "Dim"已经存在的情况下 。
请问怎样在代码里判断并创建此图层？？

谢谢！

泉(Ango)

泉(Ango) 发表于 2012-11-11 20:49
情况是这样的：

    以下是我在网上找的程序，用于标注时自动切换到标注图层（如：Dim）。

希望能有人更多人在这个贴子都都能学到东西。
所以恳请大师指点.
谢谢.

Flyingdancing

2. 添加layer用layers的add
   
3. 判断layer可以用layer的名字name
   
4. 或者layers.item(i)——就是layer；的名字name
   
5.     Set oldLayer = ThisDrawing.ActiveLayer
   
6.     ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")

添加layer用layers的add<br /> 判断layer可以用layer的名字name<br /> 或者layers.item(i)——就是layer；的名字name<br />     Set oldLayer = ThisDrawing.ActiveLayer<br />     ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")

改成

2. On Error Resume Next
   
3. Set oldlayer = ThisDrawing.Layers.Item("Dim")
   
4. If Err Then
   
5.     Err.Clear
   
6.     Set oldlayer = ThisDrawing.Layers.Add("Dim")
   
7. End If
   
8. ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")

On Error Resume Next<br /> Set oldlayer = ThisDrawing.Layers.Item("Dim")<br /> If Err Then<br />     Err.Clear<br />     Set oldlayer = ThisDrawing.Layers.Add("Dim")<br /> End If<br /> ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")

或者

2. Dim Mark As Integer
   
3. Mark = 0
   
4.     For i = 0 To ThisDrawing.Layers.Count
   
5.         If ThisDrawing.Layers(i).Name = "Dim" Then
   
6.             Mark = 1
   
7.             Exit For
   
8.         End If
   
9.     Next
   
10.     If Mark = 1 Then
    
11.         Set oldlayer = ThisDrawing.Layers.Add("dim")
    
12.     Else
    
13.         Set oldlayer = ThisDrawing.Layers.Item("Dim")
    
14.     End If
    
15.     ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")

Dim Mark As Integer<br /> Mark = 0<br />     For i = 0 To ThisDrawing.Layers.Count<br />         If ThisDrawing.Layers(i).Name = "Dim" Then<br />             Mark = 1<br />             Exit For<br />         End If<br />     Next<br />     If Mark = 1 Then<br />         Set oldlayer = ThisDrawing.Layers.Add("dim")<br />     Else<br />         Set oldlayer = ThisDrawing.Layers.Item("Dim")<br />     End If<br />     ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")

泉(Ango)

谢谢 Flyingdancing 的回复。
还有，请问你的程序应该在我下载的程序的那里插入？
（你的程序放在哪个位置？）

mccad

写成自定义函数就知道在哪插入了吧。
http://www.mjtd.com/function/lis ... ;ordertype=byletter

泉(Ango)

mccad 发表于 2012-11-14 10:03
写成自定义函数就知道在哪插入了吧。
http://www.mjtd.com/function/list.asp?id=283&ordertype=byletter

谢谢mccad的回复。
看了你帖子后还是不会把自动新建图层的程序结合到我下载的程序里。
请问你可以在我下载的程序里添加自动新建图层（Dim）的图层吗？

mccad

泉(Ango) 发表于 2012-11-14 21:44
谢谢mccad的回复。
看了你帖子后还是不会把自动新建图层的程序结合到我下载的程序里。
请问你可以在我下 ...

晕死，这是个简单的问题。在你需要DIM图层之前建就行。或者你在你的程序开头写都行。