TheSwamp

Code Red => VB(A) => Topic started by: David Hall on October 13, 2006, 01:24:26 PM

Title: Resolve path and dwg list
Post by: David Hall on October 13, 2006, 01:24:26 PM
I am trying to create a text file of dwg files to be processed using VBA and Acad 2007.  I thought I would use the common control dialog box, but I cant find the reference to add.  I have VS2003 and VS2005 express for C# on machine. (just fyi in case it matters)  I also have office, Im running XP pro and Office 2003 i think.

Anyway, I would like to give users a way to point to files or directory of files for batch plotting.  The batch plotting part is done, I just need to create the file to use for printing.  Any ideas what I need to reference to get this functionality?
Title: Re: Resolve path and dwg list
Post by: David Hall on October 13, 2006, 04:05:27 PM
Update

What i am trying to do is make a simple interface for some of my challenged users.  What I do is go to the folder I want to plot, and type

dir *.dwg /b/s > c:\dwgnum.dat

which creates a file that my code reads and plots.  I was thinking that if I could use the open dialog box to get a folder name w/ path, I could shell out and run my DOS command to create the file.
Title: Re: Resolve path and dwg list
Post by: David Hall on October 13, 2006, 04:06:21 PM
I have tried to use an example of the Win API, but Im lost, so if that is how I should do it, I could use some pointers
Title: Re: Resolve path and dwg list
Post by: MP on October 13, 2006, 04:13:03 PM
http://vbnet.mvps.org/index.html?code/browse/browseoverview.htm
Title: Re: Resolve path and dwg list
Post by: Bryco on October 14, 2006, 02:22:24 AM
CmdrDuh , I agree it's pretty confusing.
Here is a mix of a few different functions, including some from Mp's site. This is basically a class that does most of the folder,file handling stuff. BrowseCallbackProc needs to be in a standard module.
Title: Re: Resolve path and dwg list
Post by: Bryco on October 18, 2006, 11:08:49 PM
CmdrDuh, just wondering if it was useable to you?
Title: Re: Resolve path and dwg list
Post by: David Hall on October 23, 2006, 01:02:59 PM
sorry, i went on holiday for 4 days.  i'm going to try those out today
Title: Re: Resolve path and dwg list
Post by: David Hall on October 23, 2006, 01:03:34 PM
the fishing was great, 22 trout in 2 days.
Title: Re: Resolve path and dwg list
Post by: David Hall on October 23, 2006, 03:33:19 PM
OK, its crashing on this line
Code: [Select]
mvarFileName = String(mvarMaxFileSize, 0) in the class init sub

Code: [Select]
Private Sub Class_Initialize()
    Set cFiles = New Collection
    mvarMaxFileSize = 256
    mvarFileName = String(mvarMaxFileSize, 0)
    Set Fs = CreateObject("Scripting.FileSystemObject")
End Sub

any ideas?  It looks like a cast that went wrong

Title: Re: Resolve path and dwg list
Post by: Bryco on October 23, 2006, 05:58:58 PM
Hi CmdrDuh, I'm glad the fishing was so good, must have been a blast.

About the code, do you have incredibly long path names?
Like over  256 long, if so up the 256.
I don't know the workings of api's that well and I'm not sure if the 256 is bits or characters, but if the paths are really long try 512
Title: Re: Resolve path and dwg list
Post by: David Hall on October 23, 2006, 06:07:19 PM
it never gets far enough for me to pick a path.

The error msg is :
Quote
Compile error:
Can't find project or library[/quote
Title: Re: Resolve path and dwg list
Post by: David Hall on October 23, 2006, 06:09:58 PM
using this
Code: [Select]
Sub GetFolder()
    Dim CD As CommonDialog
    Dim sFolder As String
    Set CD = New CommonDialog  ' this line calls the init class
    CD.DialogTitle = "Pick the drawings folder:"
    sFolder = CD.BrowseForFolder("C")
    Debug.Print sFolder
End Sub
it goes to this
Code: [Select]
Private Sub Class_Initialize()
    Set cFiles = New Collection
    mvarMaxFileSize = 256
    mvarFileName = String(mvarMaxFileSize, 0)
    Set Fs = CreateObject("Scripting.FileSystemObject")
End Sub
Title: Re: Resolve path and dwg list
Post by: David Hall on October 23, 2006, 06:11:19 PM
I have never used API calls, mostly because I never learned how, so I have no clue whats wrong
Title: Re: Resolve path and dwg list
Post by: David Hall on October 23, 2006, 06:17:36 PM
I was just told I might need VB6.  Anybody else have issues like this?
Title: Re: Resolve path and dwg list
Post by: Bryco on October 23, 2006, 08:54:32 PM
There is a problem with   BrowseForFolderByPIDL as vb5 doesn't have a AddressOf , but I have a fix I used in acad2000. I'll have a look when I get home.
Title: Re: Resolve path and dwg list
Post by: Bryco on October 23, 2006, 11:08:15 PM
Oops 2000i is vb6.
Perhaps someone can verify there is no problem w/ vb6.  It works for me.

Here is the 2000 stuff to add
Code: [Select]

'for 2000

Private Declare Function GetCurrentVbaProject _
 Lib "vba332.dll" Alias "EbGetExecutingProj" _
 (hProject As Long) As Long
Private Declare Function GetFuncID _
 Lib "vba332.dll" Alias "TipGetFunctionId" _
 (ByVal hProject As Long, ByVal strFunctionName As String, _
 ByRef strFunctionId As String) As Long
Private Declare Function GetAddr _
 Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
 (ByVal hProject As Long, ByVal strFunctionId As String, _
 ByRef lpfn As Long) As Long

'for 2000


In  the functiion                        Public Function BrowseForFolderByPIDL
Replace                                .lpfn = FARPROC(AddressOf BrowseCallbackProc)
with                                       .lpfn = FARPROC(AddrOf("BrowseCallbackProc")) '''''''''2000

Public Function AddrOf(strFuncName As String) As Long
    Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String
   
    Const NO_ERROR = 0
   
    ' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
   
    ' Get the current VBA project
    ' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
    ' so now we just check the project handle when the function returns.
    Call GetCurrentVbaProject(hProject)
   
    ' Make sure we got a project handle... we always should, but you never know!
    If hProject <> 0 Then
        ' Get the VBA function ID (whatever that is!)
        lngResult = GetFuncID( _
         hProject, strFuncNameUnicode, strID)
       
        ' We have to check this because we GPF if we try to get a function pointer
        ' of a non-existent function.
        If lngResult = NO_ERROR Then
            ' Get the function pointer.
            lngResult = GetAddr(hProject, strID, lpfn)
           
            If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
   
End Function