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.lspskysurfer 发表于 2008-9-1 19:47:00
感觉附件里的东西不错,谢谢14楼的兄弟zctao1966 发表于 2008-11-1 23:53:00
谢谢分享!!