社区 › VBA/VB/ActiveX/API 编程技术 › AutoCAD VBA判断指定图层是否存在,如不存在则新建.

泉(Ango) 发表于 2012-11-11 01:14:34

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

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

泉(Ango) 发表于 2012-11-11 01:18:05

本帖最后由 泉(Ango) 于 2012-11-11 20:49 编辑

还有，新建新建该图层（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 发表于 2012-11-11 11:03:12

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

泉(Ango) 发表于 2012-11-11 20:49:57

Flyingdancing 发表于 2012-11-11 11:03 static/image/common/back.gif
找到对象模型（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) 发表于 2012-11-11 20:53:04

泉(Ango) 发表于 2012-11-11 20:49 static/image/common/back.gif
情况是这样的：

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


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

Flyingdancing 发表于 2012-11-12 08:53:28

本帖最后由 Flyingdancing 于 2012-11-12 08:55 编辑

添加layer用layers的add
判断layer可以用layer的名字name
或者layers.item(i)——就是layer；的名字name
    Set oldLayer = ThisDrawing.ActiveLayer
    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")改成On Error Resume Next
Set oldlayer = ThisDrawing.Layers.Item("Dim")
If Err Then
    Err.Clear
    Set oldlayer = ThisDrawing.Layers.Add("Dim")
End If
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")或者Dim Mark As Integer
Mark = 0
    For i = 0 To ThisDrawing.Layers.Count
      If ThisDrawing.Layers(i).Name = "Dim" Then
            Mark = 1
            Exit For
      End If
    Next
    If Mark = 1 Then
      Set oldlayer = ThisDrawing.Layers.Add("dim")
    Else
      Set oldlayer = ThisDrawing.Layers.Item("Dim")
    End If
    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Dim")

泉(Ango) 发表于 2012-11-13 20:03:11

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

mccad 发表于 2012-11-14 10:03:33

写成自定义函数就知道在哪插入了吧。
http://www.mjtd.com/function/list.asp?id=283&ordertype=byletter

泉(Ango) 发表于 2012-11-14 21:44:19

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

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

mccad 发表于 2012-11-15 21:12:59

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

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

查看完整版本: AutoCAD VBA判断指定图层是否存在,如不存在则新建.