fawn_lgc 发表于 2007-10-23 13:00:00

<p>提供自动切换图层的程序就可以实现&nbsp; </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/>&nbsp;&nbsp;&nbsp; Select Case LCase(CommandName)<br/>Case "bhatch"</p><p>&nbsp;&nbsp;&nbsp; Tmply = ThisDrawing.GetVariable("clayer")<br/>&nbsp;&nbsp;&nbsp; If LCase(Tmply) &lt;&gt; "han" Or Clay = "" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'ThisDrawing.SetVariable "clayer", Clay<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Clay = ThisDrawing.GetVariable("clayer")<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.Layers.Add "han"<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.SetVariable "clayer", "han"<br/>Case "dimlinear", "dimaligned", "dimordinate", "dimradius", "dimdiameter", "dimangular", "qdim", "dimbaseline", "dimcontinue"<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Clay = ThisDrawing.GetVariable("clayer")<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.Layers.Add "dim"<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.SetVariable "clayer", "dim"<br/>Case "text", "mtext"<br/>&nbsp;&nbsp;&nbsp; Clay = ThisDrawing.GetVariable("clayer")<br/>&nbsp;&nbsp;&nbsp; Select Case LCase(Clay)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case "vbtk", "mxbdata", "vbjsxn", "label"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DoEvents<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.Layers.Add "02c"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SetVariable "clayer", "02c"<br/>&nbsp;&nbsp;&nbsp; End Select<br/>'唉,不好办,我的明细表,画图框都要写文字,而又不能放到02c。<br/>Case Else<br/>&nbsp;&nbsp;&nbsp; Tmply = ThisDrawing.GetVariable("clayer")<br/>&nbsp;&nbsp;&nbsp; If LCase(Tmply) = "han" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Clay &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SetVariable "clayer", Clay<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Clay = ""<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; ElseIf Tmply = "0" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.Layers.Add "01"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SetVariable "clayer", "01"<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; 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/>&nbsp;&nbsp;&nbsp; Case "bhatch", "dimlinear", "dimaligned", "dimordinate", "dimradius", "dimdiameter", "dimangular", "qdim", "dimbaseline", "dimcontinue", "text", "mtext"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SetVariable "clayer", Clay<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 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

谢谢分享!!
页: 1 [2] 3
查看完整版本: [编程申请]不管当前层是什么,所有标注都放在特定的层里