CAD 对象加上超链接 -

Sub Add_HyperLinks()

    Dim Hyperlinks As AcadHyperlinks
    Dim Hyperlink As AcadHyperlink

    Dim Obj As AcadEntity

    For Each Obj In ThisDrawing.ModelSpace
        Set Hyperlinks = Obj.Hyperlinks
        Set Hyperlink = Hyperlinks.Add("田草博客")
            Hyperlink.URL = "http://www.tiancao.net"
            Hyperlink.URLDescription = "Ctrl+单击编辑对象"
            Hyperlink.URLNamedLocation = "田草博客"
    Next

End Sub

[本日志由 tiancao1001 于 2008-07-11 11:14 PM 编辑]

分享到： QQ空间新浪微博腾讯微博微信更多

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

发表评论 - 不要忘了输入验证码哦！

作者：

用户：密码：注册？验证：