batch bind directory of drawings

Hi group,

I am looking for some help in collecting a directory of drawings and binding
them in a batch mode.
I found a few browse functions on-line. I'm not sure what the differences
are yet but they all seem to be able to drill into a directory. I think I
got this from vbnet?
In the future I'll most likely try to place the filenames in a ListBox but
for right now I just want to read the entire directory. every file in the
pointed directory will be bound.

I'd guess that I'll need to create a list of the file to pass to a open
drawing command then run the batch section before I then save the drawing
and then move to the next drawing.


Any directions or what to look out for is appreciated.

Thanks all, Have a great day.

John coon


Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const MAX_PATH = 256

Public pidl As Long

Public Declare Function SHGetPathFromIDList _
Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Function Browse() As String

Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer

Dim lblSelected As String
lblSelected = ""

'Fill the BROWSEINFO structure with the needed data

'the calling app
bi.hOwner = 0 ' Me.HWnd

'Pointer to the item identifier list specifying
'the location of the "root" folder to browse from.
'If NULL, the desktop folder is used.
bi.pidlRoot = 0&

'message to be displayed in the Browse dialog
bi.lpszTitle = "Select your Windows directory..." + Chr(13) _
+ "(network drives must be mapped)"

'the type of folder to return.
bi.ulFlags = BIF_RETURNONLYFSDIRS _
Or BIF_DONTGOBELOWDOMAIN

'show the browse for folders dialog
pidl = SHBrowseForFolder(bi)

'the dialog has closed, so parse & display the
'user's returned folder selection contained in pidl
path = Space$(MAX_PATH)

If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
lblSelected = Left(path, pos - 1)
End If

Call CoTaskMemFree(pidl)

'return the result
Browse = lblSelected

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
bind drawing section
Private Sub bind()
Dim blocks As AcadBlocks

On Error GoTo ERR_Control

bPrefixName = True
Set blocks = ThisDrawing.blocks
For Each Block In blocks
If Block.IsXRef Then
Block.Reload
On Error GoTo ERR_Control
Block.bind (bPrefixName)
End If
Next

ERR_Control:
MsgBox "External Reference Errors were encountered!" & vbCr & _
"The Bind Macro was unable to bind all Xrefs." & vbCr & _
"You MUST manually bind the Xrefs, or insert" & vbCr & _
"them as blocks.", vbCritical, "Alert"
End Sub

 

If I understand you correctly something like the following.
You need a reference to the Microsoft Scripting Runtime (scrrun.dll)
----------
Option Explicit
Option Compare Text

Dim intSDI As Integer
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
intSDI = ThisDrawing.GetVariable("SDI")
ThisDrawing.SetVariable "SDI", 0
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder("YOUR PATH")
For Each objFile In objFolder.Files
If objFile.Name Like "*.dwg" = True Then
Application.Documents.Open "YOUR PATH" & objFile.Name

ThisDrawing.Save
ThisDrawing.Close
Next objFile
ThisDrawing.SetVariable "SDI", intSDI

 

Nathan,
I added the Microsoft Scripting Runtime but I get a "next without for"
error. I 'm in uncharted territory so I'm not sure what to do next.

John coon

Option Explicit
Option Compare Text
Sub test()

Dim intSDI As Integer
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
intSDI = ThisDrawing.GetVariable("SDI")
ThisDrawing.SetVariable "SDI", 0
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder("c:\1000\")
For Each objFile In objFolder.Files
If objFile.Name Like "*.dwg" = True Then
Application.Documents.Open "c:\1000\ & objFile.Name"
Dim i As Scripting.File
ThisDrawing.Save
ThisDrawing.Close


Next objFile
ThisDrawing.SetVariable "SDI", intSDI

End Sub

 

Nathan,

I added the Microsoft Scripting Runtime but get a "next without for" error.
I'm in uncharted territory so I not sure what to do next.

Thanks
John Coon

Option Explicit
Option Compare Text
Sub test()

Dim intSDI As Integer
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
intSDI = ThisDrawing.GetVariable("SDI")
ThisDrawing.SetVariable "SDI", 0
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder("c:\1000\")
For Each objFile In objFolder.Files
If objFile.Name Like "*.dwg" = True Then
Application.Documents.Open "c:\1000\ & objFile.Name"
Dim i As Scripting.File
ThisDrawing.Save
ThisDrawing.Close


Next objFile
ThisDrawing.SetVariable "SDI", intSDI

End Sub

 

you're missing an End if

''''you probably don't want to Dim i inside your "For" loop
'''and since you don't use it, you probably don't want it at all

End if '(or where ever you intended it to be - but it has to be before the
"Next" loop closure)

 

Sorry John, As Mark pointed out my code was missing an End If after ThisDrawing.Close
Regards - Nathan

 

I added the Microsoft Scripting Runtime but get a "next without for" error.
you gotta love those vba error descriptions...

Kevin

 

Thanks guys, I was able to retrieve the directory file names with your help.

Have a great day, Thanks
John Coon