[编程申请]不管当前层是什么,所有标注都放在特定的层里

fawn_lgc

提供自动切换图层的程序就可以实现 

本论坛有提供，好像是用VBA开发的，不过我没有用过

图层自动切换程序 V2

我用lisp也开发了一个，因为时间原因还有不是问题需要完善，以后有机会发上来。

lixiang_sh

等待中

英雄无敌

其实做这个最好是用VBA，当然，用LISP也是可以的，不过代码相对可参较长，我把我做的一个提供给大家做参考，当然，如果要在R14下用，可能还得安装VBA系统。

放到Thisdrawing的代码里面。

Option Explicit
Dim Clay As String

Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
On Error Resume Next
Dim tt As String
Dim Tmply As String
'Debug.Print CommandName
    Select Case LCase(CommandName)
Case "bhatch"

    Tmply = ThisDrawing.GetVariable("clayer")
    If LCase(Tmply) <> "han" Or Clay = "" Then
        'ThisDrawing.SetVariable "clayer", Clay
        Clay = ThisDrawing.GetVariable("clayer")
    End If
    ThisDrawing.Layers.Add "han"
    ThisDrawing.SetVariable "clayer", "han"
Case "dimlinear", "dimaligned", "dimordinate", "dimradius", "dimdiameter", "dimangular", "qdim", "dimbaseline", "dimcontinue"
   
    Clay = ThisDrawing.GetVariable("clayer")
    ThisDrawing.Layers.Add "dim"
    ThisDrawing.SetVariable "clayer", "dim"
Case "text", "mtext"
    Clay = ThisDrawing.GetVariable("clayer")
    Select Case LCase(Clay)
        Case "vbtk", "mxbdata", "vbjsxn", "label"
            DoEvents
        Case Else
       
            ThisDrawing.Layers.Add "02c"
            ThisDrawing.SetVariable "clayer", "02c"
    End Select
'唉，不好办，我的明细表，画图框都要写文字，而又不能放到02c。
Case Else
    Tmply = ThisDrawing.GetVariable("clayer")
    If LCase(Tmply) = "han" Then
        If Clay <> "" Then
            ThisDrawing.SetVariable "clayer", Clay
            Clay = ""
        End If
    ElseIf Tmply = "0" Then
        ThisDrawing.Layers.Add "01"
        ThisDrawing.SetVariable "clayer", "01"
   
    End If
End Select

End Sub

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
On Error Resume Next
Select Case LCase(CommandName)
    Case "bhatch", "dimlinear", "dimaligned", "dimordinate", "dimradius", "dimdiameter", "dimangular", "qdim", "dimbaseline", "dimcontinue", "text", "mtext"
        ThisDrawing.SetVariable "clayer", Clay
        Clay = ""
End Select

End Sub

liuhoujun

网上找的!您把里面的41层改为您要的标注层就OK!

hb_xiaofen

可以用VBA的事件来控制，以前编过一个类似的，不过感觉意义不是很大，扔掉了

hb_xiaofen

可以用VBA的 begincommand()方法，当调用指定的命令前执行相应的程序

endcommand（）方法也好用，我以前写过，能用，后来忘记扔那去了，

AMTONNY

燕秀工具箱有这个把所有标注归入标注层呀

jeafly

autolayer[3.0].lsp

skysurfer

感觉附件里的东西不错，谢谢14楼的兄弟

zctao1966

谢谢分享！！