删除现有超链接

Matersammichman · 发表于 2006-6-30 09:49:57

我正在使用VB6打开CAD图纸，并希望从图纸中删除现有的超链接。我可以在VBA工作，但不是纯VB。
帮助？

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

DaveW · 发表于 2006-6-30 10:37:11

你有成功的vb6项目工作吗？
您正在制作一个activex dll吗？如果是这样，您如何链接到它？
缺少您的信息。
发布一些代码。
另外，如果你在设置一个纯vb项目时需要帮助，看看这个：
http://www.websitetoolbox.com/tool/post/milllister/vpost?id=1071084&trail=30#1
你可以回到 http://milllister.com/ 页面，拿起我的手机，打电话给我，如果你在设计时需要帮助调试。

Matersammichman · 发表于 2006-6-30 11:07:50

以下是我尝试的…
将ACADHYPERLINK设置为对象
设置Acadhyper Link=acadDoc。ACADHYPERLINK＜br＞用于acadDoc＜br＞ACADHYPERLINK中的每个Acadhyper link。删除下一个ACADHYPERLINK
…不用说，它不起作用。

Matersammichman · 发表于 2006-6-30 11:32:52

不，它没有。尝试一下，可能需要一些调整。

copy

Sub test()
Dim objHL As AcadHyperlink
Dim objHLs As AcadHyperlinks
Dim objThingy As AcadEntity
For Each objThingy In acadDoc.PaperSpace
  If objThingy.Hyperlinks.Count  0 Then
    Set objHLs = objThingy.Hyperlinks
    For Each objHL In objHLs
      objHL.Delete
    Next objHL
  End If
Next objThingy
For Each objThingy In acadDoc.PaperSpace
  If objThingy.Hyperlinks.Count  0 Then
    Set objHLs = objThingy.Hyperlinks
    For Each objHL In objHLs
      objHL.Delete
    Next objHL
  End If
Next objThingy
End Sub

这是VBA完成的，然后此绘图被更改为acaddoc，因此您必须设置acaddoc等。

Kerry · 发表于 2006-6-30 11:43:57

只是为了理解它，不起作用的原因是您告诉VB的是它将遍历绘图中的所有内容，并且它会在绘图中找到的所有内容都是超链接。它首先到达的不是超链接，程序说，“嘿，这不是你的超链接。我想我要扔掉宾基了。"
代码唯一有效的时候是如果您的绘图中只包含超链接，而超链接永远不会发生，原因有两个。
1）文件空间和模型空间都是块，您无法摆脱它们。
2）绘图中不能有超链接。超链接附加到对象，而不是对象本身。
有意义吗？

Matersammichman · 发表于 2006-6-30 12:48:44

Bob，
我在VB6学习版...
我尝试了您的代码，但VB6无法识别“Dim ObjHL As AcadHyperlink”。它给我一个错误，“未定义用户定义类型”。我还需要做什么？
Dave，
建设性的批评总是受欢迎的...好的代码也总是受欢迎的。
我是使用VB6访问Cad的新手。

Matersammichman · 发表于 2006-6-30 13:03:41

听起来您需要添加对AutoCAD类型库的引用
此外，如果您像下面这样对数据库进行迭代，它将获得除modelspace和paperspace中的链接外嵌入到块中的任何链接。

copy

Sub removeHyperLinks(ByRef doc As AcadDocument)
  Dim block As AcadBlock
  For Each block In doc.Blocks
     Dim ent As AcadEntity
     For Each ent In block
      Dim links As AcadHyperlinks
      Set links = ent.hyperLinks
      If links.Count  0 Then
        Dim link As AcadHyperlink
        For Each link In links
          link.Delete
        Next link
        Set link = Nothing
      End If
     Next ent
     Set ent = Nothing
  Next block
  Set block = Nothing
End Sub