社区 › VB › 重新访问的超链接文件

krampaul82 发表于 2009-6-24 14:52:30

重新访问的超链接文件

'---------------------------------------------------------------------------------------
' Module    : Module_get_hyperlink_cut_sheets
' DateTime: 5/01/2009 13:21
' Author    : Mark
' Purpose   : The Program will sort through the current drawings model space blocks
'         : and find any associated hyperlinks to a PDF Cut Sheet and move that cut
'         : sheet to the PATH v:\Current_Project\Cut Sheets\ Directory.
'---------------------------------------------------------------------------------------
Option Explicit
Public Sub Gartner_Get_Hyperlink_Main()
    Dim objBlock As AcadBlockReference
    Dim objEnt As AcadEntity
    Dim colHyps As AcadHyperlinks
    Dim fso As FileSystemObject
   
   
    Set fso = New FileSystemObject
   
    If Len(Dir(ThisDrawing.Path & "\Cut Sheets\*.pdf"))0 Then
    ' Checks to see if there are any PDFs in CURRENT_Project\Cut Sheets\
      fso.DeleteFile ThisDrawing.Path & "\Cut Sheets\*.pdf", True
      ' If there are, delete them
    End If
   
    For Each objEnt In ThisDrawing.ModelSpace
      If TypeOf objEnt Is AcadBlockReference Then
            Set objBlock = objEnt
            Set colHyps = objBlock.Hyperlinks
            On Error Resume Next
            ' In case we encounter any blocks that DON'T have hyperlinks
            fso.CopyFile colHyps.Item(0).URL, ThisDrawing.Path & "\Cut Sheets\*.pdf", True
         ' The TRUE option will automatically overwrite any existing files with the same name
      End If
    Next objEnt
   
    Set fso = Nothing
End Sub

此代码不起作用，Matt W迄今为止一直在帮助我，但似乎已经失去了兴趣……这是我附加超链接的方式吗
（通过块编辑器完成）如有任何帮助，将不胜感激&nbsp；我对VBA掌握得不够好，不知道它在哪里失败了…&nbsp；

Matt__W 发表于 2009-6-24 15:43:33

想把我扔到公共汽车下面，嗯&nbsp
是的，看来它赢了；在块编辑器中附加超链接时，请不要读取超链接
更改此行…
fso.CopyFile colHyps.Item(0).URL, ThisDrawing.Path & "\Cut Sheets\*.pdf", True 对此
fso.CopyFile colHyps.Item(0).URL, ThisDrawing.Path & "\Cut Sheets\", True

krampaul82 发表于 2009-6-24 16:24:40

马特，请不要以为我是在向你开枪，把你扔到公共汽车下面，只是以为你厌倦了我的无知，开始做更大更好的事情
下一个问题，我有500多个带有超链接的块，通过块编辑器Arggghhh连接；有没有一种方法可以自动化超链接过程，而不必通过每个属性重新连接超链接
标记

Matt__W 发表于 2009-6-24 16:25:14

我在你的帖子中添加了代码标签，使其更具可读性

krampaul82 发表于 2009-6-24 16:50:14

可能，但不是我&#039；我知道&nbsp&nbsp；

Matt__W 发表于 2009-6-24 16:58:49

可能，但不是我&#039；我知道&nbsp&nbsp
谢谢你抽出时间&nbsp；它也不会生成通过属性将其附着的剪切图纸&nbsp；这将大大节省时间！叹息…
马克

krampaul82 发表于 2009-6-25 08:20:10

可能，但不是我&#039；我知道&nbsp&nbsp
谢谢你抽出时间&nbsp；它也不会生成通过属性将其附着的剪切图纸&nbsp；这将大大节省时间！唉…
马克
这对我来说很合适。
试着注释这句话；出错时继续下一步用撇号（&#039；）在队伍前面，看它是否停下来/停在哪里。

Keith™ 发表于 2009-7-1 12:43:18

它停在这里…
fso。CopyFile colHyps。项（0）。URL，ThisDrawing。路径（&P）&引用；\剪切图纸\“；，真的

krampaul82 发表于 2009-7-1 14:32:35

路径是否存在？

n.yuan 发表于 2009-7-2 16:15:09

对当前工作。dwg位于包含名为“剪切图纸”的目录中。

查看完整版本: 重新访问的超链接文件