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迄今为止一直在帮助我,但似乎已经失去了兴趣....是我附加超链接的方式吗?
(通过块编辑器完成)任何帮助都将不胜感激!我对VBA没有足够的了解,不知道这是哪里出了问题...
**** Hidden Message *****

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

想把我扔到巴士底下,嗯?
是的,在块编辑器中附加超链接时,它似乎不会读取超链接
更改此行…
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

有可能,但据我所知没有。

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

有可能,但据我所知没有。

Matt
感谢您的时间。它也不会生成通过属性附加它的剪切表。这将是一个巨大的时间节省!叹息...
马克

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

可能吧,但我不知道。

马特
感谢您抽出时间。它也不会生成通过属性将其附着的剪切图纸。这将是一个巨大的时间节省!唉…
标记

对我来说确实如此。
试着在“下一步继续出错”时注释这一行——将撇号(')放在行的前面,看看它是否/在哪里停止。

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

它停在这里…
fso。复制文件colHyps.Item(0)。URL,此绘图。路径为“\Cut Sheets\”,为True

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

路径存在吗?

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

是的。当前工作.dwg位于包含名为“剪切表”的目录中。
页: [1] 2
查看完整版本: 超链接文件被重新访问