田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID

评论列表

所有评论
[100] [101] [102] [103] [104] [105] [106] [107] [108] [109]  ... [144]  
田草 于 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 创建匿名组
田草 于 2008-07-12 09:23 AM 发表评论:
 '创建匿名块,没有则创建,有则序号加一
Function NiMingKuai(S As String) As String
    Dim B As AcadBlock
    Dim n As Long
    Dim m As Long
    For Each B In ThisDrawing.Blocks
        If Left(B.Name, Len(S)) = S Then
            m = Val(Mid(B.Name, Len(S) + 1))
            If n <= m Then n = m + 1
        End If
    Next
    NiMingKuai = S & n
End Function
查看所评论的日志:Auto CAD vba 怎样 创建匿名块
tiancao1001 于 2008-07-11 11:38 PM 发表评论:
Sub Delete_HyperLinks()
    On Error Resume Next
    Dim Hyperlinks As AcadHyperlinks
    Dim Hyperlink As AcadHyperlink
    
    Dim Obj As AcadEntity
    Dim i As Integer
    Dim j As Long
    For Each Obj In ThisDrawing.ModelSpace
        DoEvents
        Set Hyperlinks = Obj.Hyperlinks
        MsgBox Hyperlinks.Count
        i = Hyperlinks.Count
        For j = 0 To i - 1
            Hyperlinks.item(j).Delete
        Next j
    Next

End Sub
查看所评论的日志:CAD 对象加上超链接
[100] [101] [102] [103] [104] [105] [106] [107] [108] [109]  ... [144]  
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©