tiancao1001 于 2008-07-17 09:03 PM 发表评论: |
隐藏日志的评论 |
查看所评论的日志:CAD VBA 也能画出这样的样条曲线 |
田草 于 2008-07-17 11:48 AM 发表评论: |
<SCRIPT type=text/javascript> var tips1;var tips2; var zh_theTop = 180/*这是默认高度*/; var old = zh_theTop; function initFloatTips() { tips1 = document.getElementById('adleft'); tips2 = document.getElementById('adright'); moveTips(); };
var zh_pos; function moveTips() { var tt=50; if (window.innerHeight) { zh_pos = window.pageYOffset } else if (document.documentElement && document.documentElement.scrollTop) { zh_pos = document.documentElement.scrollTop } else if (document.body) { zh_pos = document.body.scrollTop; } zh_pos=zh_pos-tips1.offsetTop+zh_theTop; zh_pos=tips1.offsetTop+zh_pos/5; if (zh_pos < zh_theTop) zh_pos = zh_theTop; if (zh_pos != old) { tips1.style.top = zh_pos+"px"; tips2.style.top = zh_pos+"px"; tt=10; } old = zh_pos; setTimeout(moveTips,tt); } initFloatTips() ; </SCRIPT>
<DIV id=adleft style="RIGHT: 2px; LINE-HEIGHT: 150%; POSITION: absolute; TOP: 150px; left: 910px; float:right"> <TABLE cellSpacing=0 cellPadding=0 width=100 border=0> <TBODY> <TR> <TD vAlign=top height=108> <TABLE cellSpacing=0 cellPadding=0 width=93 border=0> <TBODY> <TR> <TD width=107><EMBED src='EccoolAda.swf' wmode='transparent' quality=high WIDTH=100 HEIGHT=300 TYPE='application/x-shockwave-flash' id=EccoolAd></EMBED></TD> </TR> </TBODY> </TABLE> </TD> </TR> </TBODY> </TABLE> </DIV> <DIV id=adright style="LEFT: 1px; LINE-HEIGHT: 150%; POSITION: absolute; TOP: 150px"> <TABLE cellSpacing=0 cellPadding=0 width=100 border=0> <TBODY> <TR> <TD vAlign=top height=108> <TABLE cellSpacing=0 cellPadding=0 width=97 border=0> <TBODY> <TR> <TD colSpan=6 height=93><EMBED src='EccoolAdb.swf' wmode='transparent' quality=high WIDTH=100 HEIGHT=300 TYPE='application/x-shockwave-flash' id=EccoolAd></EMBED></TD> </TR> </TBODY> </TABLE> </TD> </TR> </TBODY> </TABLE> </DIV> |
|
查看所评论的日志:支持IE、Firefox、Opera的对联广告(来自网易) |
田草 于 2008-07-17 10:22 AM 发表评论: |
Function ImportWMF(P As String) '输入文件 If Dir(P) <> "" Then '判断文件是否存在 ThisDrawing.Import P, Point3D(0, 0, 0), 2 Else Prompt "程序使用的临时文件不存在,请重新运行程序!" Exit Function End If End Function |
|
查看所评论的日志:CAD VBA 输出WMF文件 和导入WMF文件 |
tiancao1001 于 2008-07-16 02:58 PM 发表评论: |
Sub DeleteMenu() '读取有那些菜单 Dim i As Integer Dim i1 As Integer Dim i2 As Integer Dim index() As Long Dim DataString As String Set FSO = CreateObject("Scripting.FileSystemObject") Set FSO_File = FSO.OpenTextFile(GetPath & "menu.txt", ForReading, True) Do While Not FSO_File.AtEndOfStream DataString = FSO_File.ReadLine i = inStr_n(DataString, ",", index) If i = 0 Then i1 = Val(DataString) ElseIf i = 1 Then DataString = Left(DataString, Len(DataString) - 1) For Each TG In ThisDrawing.Application.MenuGroups For Each T In TG.Toolbars If T.Name = DataString Then T.Delete i2 = i2 + 1 If i2 = i1 Then Exit Do End If Next Next End If Loop FSO_File.Close End Sub |
|
查看所评论的日志:ACAD vba CreateMenu2.0 自动生成CAD工具栏 |
tiancao1001 于 2008-07-15 05:31 PM 发表评论: |
'样条曲线转化为直线(针对上面函数转化后的样条曲线) Sub SPlineToLine() Dim E As AcadEntity Dim L As AcadLine Dim SP As AcadSpline Dim StartP As Variant Dim EndP As Variant For Each E In ThisDrawing.ModelSpace 'DoEvents 'ThisDrawing.Utility.Prompt E.ObjectName If E.ObjectName = "AcDbSpline" Then Set SP = E StartP = SP.GetFitPoint(0) EndP = SP.GetFitPoint(2) Set L = ThisDrawing.ModelSpace.AddLine(StartP, EndP) L.Layer = SP.Layer L.color = SP.color SP.Delete End If Next E End Sub |
|
查看所评论的日志:VBA将所有的直线转换成样条曲线 |
田草 于 2008-07-15 08:54 AM 发表评论: |
'创建匿名块 Function NiMingKuai(S As String) As String Dim blockObj As AcadBlock Dim n As Long NiMingKuai = S & "_0" Block: For Each blockObj In ThisDrawing.Blocks If blockObj.Name = NiMingKuai Then NiMingKuai = S & "_" & CStr(n) Prompt NiMingKuai n = n + 1 GoTo Block End If Next blockObj End Function |
|
查看所评论的日志:Auto CAD vba 怎样 创建匿名块 |
yc421206 于 2008-07-14 03:09 PM 发表评论: |
Dear SIR: 連結無法下載,可否MAIL至小弟信箱。 |
|
查看所评论的日志:Mastering AutoCAD VBA 从入门到精通.pdf 电子版格式 |
田草 于 2008-07-12 09:30 AM 发表评论: |
'创建匿名组,没有则创建,有则序号加一 Function NiMingZu(S As String) As String Dim G As AcadGroup Dim n As Long For Each G In ThisDrawing.Groups If Left(G.Name, Len(S)) = S Then n = n + 1 Next NiMingZu = S & n + 1 End Function |
|
查看所评论的日志:vba 创建匿名组 |