Author Topic: Hyperlink-file-manipulation  (Read 6765 times)

0 Members and 1 Guest are viewing this topic.

krampaul82

  • Guest
Hyperlink-file-manipulation
« on: May 01, 2009, 09:10:50 AM »
Hey Guy's

I have many blocks in a drawing, all have hyperlinks to a server located library of PDF documents pertaining to the block(s).
My question,  Is there a Lisp or VBA that will copy those "Hyperlinked" PDF cut sheets to a New directory called cut sheets
which will be located in a current project type directory tree.

Mark

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Hyperlink-file-manipulation
« Reply #1 on: May 01, 2009, 09:20:29 AM »
So you want to scan all blocks, find any hyperlinks, then copy the file that the hyperlink is pointing to to a project folder?

Assuming this is indeed what you want to do, this should work.

You'll need to add a reference to the Microsoft Scripting Runtime.

Code: [Select]
Option Explicit

Public Sub Main()
    Dim objBlock As AcadBlockReference
    Dim objEnt As AcadEntity
    Dim colHyps As AcadHyperlinks
    Dim fso As FileSystemObject
   
    Set fso = New FileSystemObject
   
    For Each objEnt In ThisDrawing.ModelSpace
        If TypeOf objEnt Is AcadBlockReference Then
            Set objBlock = objEnt
            Set colHyps = objBlock.Hyperlinks
            On Error Resume Next [color=green]' In case we encounter any blocks that DON'T have hyperlinks[/color]
            fso.CopyFile colHyps.Item(0).URL, "E:\Temp\"  [color=green]' replace E:\Temp\ with your project directory[/color]
        End If
    Next objEnt
   
    Set fso = Nothing
End Sub
« Last Edit: May 01, 2009, 09:45:34 AM by Matt W »
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

krampaul82

  • Guest
Re: Hyperlink-file-manipulation
« Reply #2 on: May 01, 2009, 12:03:42 PM »
Matt,

Thank you for your quick reply! You Mention Microsoft run time scripting? do I need to get some software? or make a reference to a piece of software that I allready Have? (Pretty New at  PO-Gramming). See Comments In the Code


Option Explicit

Public Sub Main()
    Dim objBlock As AcadBlockReference
    Dim objEnt As AcadEntity
    Dim colHyps As AcadHyperlinks
    Dim fso As FileSystemObject
   
    Set fso = New FileSystemObject
   
    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
(Is there a way to have the program to know the PATH by using the current working drawing?)
            fso.CopyFile colHyps.Item(0).URL, "E:\Temp\"  ' replace E:\Temp\ with your project directory(This Would be the PDF Source Files?)
        End If
    Next objEnt
   
    Set fso = Nothing
End Sub
 

 

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Hyperlink-file-manipulation
« Reply #3 on: May 01, 2009, 01:16:26 PM »
You Mention Microsoft run time scripting? do I need to get some software? or make a reference to a piece of software that I allready Have?
To add a reference to the Microsoft Scripting Runtime, in the IDE click TOOLS -- REFERENCES (see the first image) then select Microsoft Scripting Runtime (see the second image).


Code: [Select]
Option Explicit

Public Sub Main()
    Dim objBlock As AcadBlockReference
    Dim objEnt As AcadEntity
    Dim colHyps As AcadHyperlinks
    Dim fso As FileSystemObject
   
    Set fso = New FileSystemObject
   
    For Each objEnt In ThisDrawing.ModelSpace
        If TypeOf objEnt Is AcadBlockReference Then
            Set objBlock = objEnt
            Set colHyps = objBlock.Hyperlinks
            On Error Resume Next [color=green]' In case we encounter any blocks that DON'T have hyperlinks[/color]
[color=red](Is there a way to have the program to know the PATH by using the current working drawing?)[/color]
[color=blue]Do you mean the current drawing's location?  That path??!?[/color]

            fso.CopyFile colHyps.Item(0).URL, "E:\Temp\"  [color=green]' replace E:\Temp\ with your project directory[/color]
[color=red](This Would be the PDF Source Files?)[/color]
[color=blue]This is where the files will be copied to.[/color]

        End If
    Next objEnt
   
    Set fso = Nothing
End Sub

« Last Edit: May 01, 2009, 01:21:32 PM by Matt W »
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

krampaul82

  • Guest
Re: Hyperlink-file-manipulation
« Reply #4 on: May 01, 2009, 01:53:52 PM »
Matt,

Again Thank You for your time see comments in code.


Option Explicit

Public Sub Main()
    Dim objBlock As AcadBlockReference
    Dim objEnt As AcadEntity
    Dim colHyps As AcadHyperlinks
    Dim fso As FileSystemObject
   
    Set fso = New FileSystemObject
   
    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
(Is there a way to have the program to know the PATH by using the current working drawing?)
Do you mean the current drawing's location?  That path??!?(Yes, The current working drawing resides in a Project Directory, also a Directory called Cut_Sheets resides in the Project Directory. Here is where I want the PDF Cut Sheets to end up.)

            fso.CopyFile colHyps.Item(0).URL, "E:\Temp\"  ' replace E:\Temp\ with your project directory
(This Would be the PDF Source Files?)
This is where the files will be copied to.

        End If
    Next objEnt
   
    Set fso = Nothing
End Sub

krampaul82

  • Guest
Re: Hyperlink-file-manipulation
« Reply #5 on: May 01, 2009, 02:25:39 PM »
Matt,

Here is a little program that I wrote to start a new project for my company's specific needs.
this might help to see the need to move hyperlinked cut sheets

krampaul82

  • Guest
Re: Hyperlink-file-manipulation
« Reply #6 on: May 01, 2009, 03:27:04 PM »
Matt,

Let's say I use DATA Extraction for BOM creation and have 5 Multiple Block Assembly drawings in Model Space but I only Show 1 Assembly in Paper Space Layout. Is there also a way to prevent moving duplicate PDF Cut Sheets to the same Directory or will the program crash or will it prompt me to overwrite any duplicate files comming in?  Also, our projects change alot, some blocks will be deleteted and others added and I run this program again, is it possible to delete the existing files in the Cut_Sheet Directory and re-populate with the new modified current drawing cut sheets?


Mark

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Hyperlink-file-manipulation
« Reply #7 on: May 04, 2009, 08:10:25 AM »
Is there also a way to prevent moving duplicate PDF Cut Sheets to the same Directory or will the program crash or will it prompt me to overwrite any duplicate files comming in?
This will automatically delete all PDFs from a particular directory, in this case E:\Temp.  Change it to your project folder where the PDFs will be stored.

Code: [Select]
[color=red]If Len(Dir("E:\Temp\*.pdf")) <> 0 Then[/color]      [color=green]' Checks to see if there are any PDFs in E:Temp[/color]
    [color=red]fso.DeleteFile "E:\Temp\*.pdf", True[/color]    [color=green]' If there are, delete them[/color]
[color=red]End If[/color]

Also, our projects change alot, some blocks will be deleteted and others added and I run this program again, is it possible to delete the existing files in the Cut_Sheet Directory and re-populate with the new modified current drawing cut sheets?

This line will automatically overwrite any PDFs that may have the same name as the one(s) being copied.

Code: [Select]
fso.CopyFile colHyps.Item(0).URL, "E:\Temp\", True
And when you put it all together, you get this...

Code: [Select]
Option Explicit

Public Sub Main()
    Dim objBlock As AcadBlockReference
    Dim objEnt As AcadEntity
    Dim colHyps As AcadHyperlinks
    Dim fso As FileSystemObject
   
    Set fso = New FileSystemObject

    [color=red]If Len(Dir("E:\Temp\*.pdf")) <> 0 Then[/color]      [color=green]' Checks to see if there are any PDFs in E:Temp[/color]
        [color=red]fso.DeleteFile "E:\Temp\*.pdf", True[/color]    [color=green]' If there are, delete them[/color]
    [color=red]End If[/color]
   
    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
            [color=red]fso.CopyFile colHyps.Item(0).URL, "E:\Temp\", True[/color]  [color=green]' replace E:\Temp\ with your project directory[/color]
                                                                [color=green]' The TRUE option will automatically overwrite any existing files with the same name[/color]
        End If
    Next objEnt
   
    Set fso = Nothing
End Sub
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Hyperlink-file-manipulation
« Reply #8 on: May 04, 2009, 08:13:19 AM »
(Is there a way to have the program to know the PATH by using the current working drawing?)
Do you mean the current drawing's location?  That path??!?(Yes, The current working drawing resides in a Project Directory, also a Directory called Cut_Sheets resides in the Project Directory. Here is where I want the PDF Cut Sheets to end up.)

To get the current drawing's location, you can use ThisDrawing.Path.

To test it, just put this in an empty SUB and run it.  It will display a dialog box with the drawing's path.

Code: [Select]
MsgBox ThisDrawing.Path
You can then append the Cut_Sheets folder to that path by using

Code: [Select]
MsgBox ThisDrawing.Path & "\Cut_Sheets"
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

krampaul82

  • Guest
Re: Hyperlink-file-manipulation
« Reply #9 on: May 04, 2009, 09:26:42 AM »
Matt

Again Thank You and please, forgive my mental block here
see code in red,

Mark


Option Explicit

Public Sub Main()
    Dim objBlock As AcadBlockReference
    Dim objEnt As AcadEntity
    Dim colHyps As AcadHyperlinks
    Dim fso As FileSystemObject
   
    Set fso = New FileSystemObject

    If Len(Dir("E:\Temp\*.pdf")) <> 0 Then      ' Checks to see if there are any PDFs in E:Temp
        fso.DeleteFile "E:\Temp\*.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, "E:\Temp\",(is how where I would put this? ThisDrawing.Path & "\Cut_Sheets\", True)  ' replace E:\Temp\ with your project directory
                                                                ' The TRUE option will automatically overwrite any existing files with the same name
        End If
    Next objEnt
   
    Set fso = Nothing
End Sub

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Hyperlink-file-manipulation
« Reply #10 on: May 04, 2009, 09:29:31 AM »
Uh huh.  :-)
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

krampaul82

  • Guest
Re: Hyperlink-file-manipulation
« Reply #11 on: May 04, 2009, 02:17:42 PM »
Matt
This is not working :-(
is there a typo problem on my part?
mark

'---------------------------------------------------------------------------------------
' 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

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Hyperlink-file-manipulation
« Reply #12 on: May 04, 2009, 02:26:31 PM »
What's the path for your drawings?  Where are they located?
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

krampaul82

  • Guest
Re: Hyperlink-file-manipulation
« Reply #13 on: May 04, 2009, 03:37:41 PM »
Matt
The active current working drawing could come from multiple paths ie, V:\Control Projects-09\09-431-Casino\current_drawing, or V:\Control Projects-09\09-431-Casino\As_Built\current_drawing or  V:\Control Projects-089\08-405-Car-Park\current_drawing etc. it all depends which project I am currently working on.  I would like to be able to run this VBA application from any active current working drawing and it will know the Directory PATH from it.  Were the Directory that the current working drawing resides also contains a Directory called Cut Sheets. that is were I want the Block hyperlinked.pdf cut sheet to go.
Mark

krampaul82

  • Guest
Re: Hyperlink-file-manipulation
« Reply #14 on: May 04, 2009, 04:16:36 PM »
Matt
I Attach a Hyperlink through the Properties dialoag from within the ACAD 2009 Block Editor
Mark