fawn_lgc
发表于 2007-10-23 13:00:00
<p>提供自动切换图层的程序就可以实现 </p><p>本论坛有提供，好像是用VBA开发的，不过我没有用过</p><p><a href="http://www.mjtd.com/mcdown/list.asp?id=52">图层<font color="#ff0000">自动切换</font>程序 V2</a></p><p>我用lisp也开发了一个，因为时间原因还有不是问题需要完善，以后有机会发上来。</p>
lixiang_sh
发表于 2007-11-26 22:44:00
<p>等待中</p>
英雄无敌
发表于 2007-11-28 08:22:00
<p>其实做这个最好是用VBA，当然，用LISP也是可以的，不过代码相对可参较长，我把我做的一个提供给大家做参考，当然，如果要在R14下用，可能还得安装VBA系统。</p><p>放到Thisdrawing的代码里面。</p><p>Option Explicit<br/>Dim Clay As String</p><p>Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)<br/>On Error Resume Next<br/>Dim tt As String<br/>Dim Tmply As String<br/>'Debug.Print CommandName<br/> Select Case LCase(CommandName)<br/>Case "bhatch"</p><p> Tmply = ThisDrawing.GetVariable("clayer")<br/> If LCase(Tmply) <> "han" Or Clay = "" Then<br/> 'ThisDrawing.SetVariable "clayer", Clay<br/> Clay = ThisDrawing.GetVariable("clayer")<br/> End If<br/> ThisDrawing.Layers.Add "han"<br/> ThisDrawing.SetVariable "clayer", "han"<br/>Case "dimlinear", "dimaligned", "dimordinate", "dimradius", "dimdiameter", "dimangular", "qdim", "dimbaseline", "dimcontinue"<br/> <br/> Clay = ThisDrawing.GetVariable("clayer")<br/> ThisDrawing.Layers.Add "dim"<br/> ThisDrawing.SetVariable "clayer", "dim"<br/>Case "text", "mtext"<br/> Clay = ThisDrawing.GetVariable("clayer")<br/> Select Case LCase(Clay)<br/> Case "vbtk", "mxbdata", "vbjsxn", "label"<br/> DoEvents<br/> Case Else<br/> <br/> ThisDrawing.Layers.Add "02c"<br/> ThisDrawing.SetVariable "clayer", "02c"<br/> End Select<br/>'唉，不好办，我的明细表，画图框都要写文字，而又不能放到02c。<br/>Case Else<br/> Tmply = ThisDrawing.GetVariable("clayer")<br/> If LCase(Tmply) = "han" Then<br/> If Clay <> "" Then<br/> ThisDrawing.SetVariable "clayer", Clay<br/> Clay = ""<br/> End If<br/> ElseIf Tmply = "0" Then<br/> ThisDrawing.Layers.Add "01"<br/> ThisDrawing.SetVariable "clayer", "01"<br/> <br/> End If<br/>End Select</p><p>End Sub</p><p>Private Sub AcadDocument_EndCommand(ByVal CommandName As String)<br/>On Error Resume Next<br/>Select Case LCase(CommandName)<br/> Case "bhatch", "dimlinear", "dimaligned", "dimordinate", "dimradius", "dimdiameter", "dimangular", "qdim", "dimbaseline", "dimcontinue", "text", "mtext"<br/> ThisDrawing.SetVariable "clayer", Clay<br/> Clay = ""<br/>End Select</p><p>End Sub<br/></p>
liuhoujun
发表于 2008-4-1 12:42:00
<p>网上找的!您把里面的41层改为您要的标注层就OK!</p><p></p>
hb_xiaofen
发表于 2008-4-7 13:19:00
可以用VBA的事件来控制，以前编过一个类似的，不过感觉意义不是很大，扔掉了
hb_xiaofen
发表于 2008-7-24 21:44:00
<p>可以用VBA的 begincommand()方法，当调用指定的命令前执行相应的程序</p><p>endcommand（）方法也好用，我以前写过，能用，后来忘记扔那去了，</p>
AMTONNY
发表于 2008-8-17 00:03:00
燕秀工具箱有这个把所有标注归入标注层呀
jeafly
发表于 2008-8-31 09:47:00
autolayer.lsp
skysurfer
发表于 2008-9-1 19:47:00
感觉附件里的东西不错，谢谢14楼的兄弟
zctao1966
发表于 2008-11-1 23:53:00
谢谢分享！！