Author Topic: Setting initial open directory to folder with given name  (Read 5302 times)

0 Members and 1 Guest are viewing this topic.

ELOQUINTET

  • Guest
Setting initial open directory to folder with given name
« on: March 21, 2007, 03:29:35 PM »
OK let me explain the big picture so it will make sense. We have a routine that will update an attribute in a multiple files. when the open dialogue box comes up it goes to the folder below. i'm thinking i want it to start in the drawings folder as we all have a folder which contains our drawings within. the problem is that we don't all have this folder on the same drive. for some it is in their C: and others in their D:. Is there a way I can just specify drawings and it will find it whther in C: OR D:?

myOpen.InitDir = "I:\HOME\cadfiles\ACAD\LSP" 'Set initial folder

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Setting initial open directory to folder with given name
« Reply #1 on: March 21, 2007, 03:40:17 PM »
If the path is the same you can simply iterate through all drives.
Code: [Select]
For X = 65 to 90
   rVal = Dir(chr(X) & ":\Mypath\MyFile.ext")
   If rVal <> "" Then
     X = 91
   End If
Next X

This will require some error checking since it will fail if the drive does not exist or is not ready .. but it will find it on all drives A - Z

Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

ELOQUINTET

  • Guest
Re: Setting initial open directory to folder with given name
« Reply #2 on: March 21, 2007, 03:57:38 PM »
Keith I did some asking around and everyone has this folder on their D: except 1 who has it on their E:

The tricky thing with this that I forgot to mention, because it just dawned on me.
We are not working off of a server but instead as a workgroup.
Each of us is mapped to one anothers drawings folder so is there a way to only look for and in specific drive letters?

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Setting initial open directory to folder with given name
« Reply #3 on: March 21, 2007, 04:07:01 PM »
sure ...

Code: [Select]
For X = 67 to 69
   rVal = Dir(chr(X) & ":\Mypath\MyFile.ext")
   If rVal <> "" Then
     X = 70
   End If
Next X
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

ELOQUINTET

  • Guest
Re: Setting initial open directory to folder with given name
« Reply #4 on: March 21, 2007, 04:25:35 PM »
keith I am trying to figure this out on my end but am getting errors

the private function line is highlighted and it kept highlighting x so i thought i could change all occurances to getfiles but now it is highlighting rVal. What am i messing up here?


Code: [Select]
'Display an open dialog, adds selected files to an array
Private Function GetFiles() As Variant
  'Stores the object created by the CommonDialog class
  Dim myOpen As CommonDialogProject.CommonDialog
  Set myOpen = CommonDialogProject.Init 'Create the object
 
  myOpen.DialogTitle = "Select drawings" 'Change the title
  myOpen.Filter = "AutoCAD Drawing files (*.dwg)|*.dwg|" & _
                          "AutoCAD Drawing template files (*.dwt)|*.dwt"
    myOpen.DefaultExt = "dwg"
  'Set flags to limit behavior of the dialog box
  myOpen.Flags = OFN_ALLOWMULTISELECT + _
                 OFN_EXPLORER + _
                 OFN_FILEMUSTEXIST + _
                 OFN_HIDEREADONLY + _
                 OFN_PATHMUSTEXIST
  For GetFiles = 67 To 69
   rVal = Dir(Chr(GetFiles) & ":\Drawings")
   If rVal <> "" Then
     GetFiles = 70
   End If
Next GetFiles

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Setting initial open directory to folder with given name
« Reply #5 on: March 21, 2007, 04:37:07 PM »
You can't do it that way ....

Put the code I provided into a function all of its own .. whatever the value of rVal is, will be the path to the location of the default directory. Set that value as the default directory in the Browse for Folder API
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

ELOQUINTET

  • Guest
Re: Setting initial open directory to folder with given name
« Reply #6 on: March 22, 2007, 08:37:53 AM »
Keith sorry but I'm new at this and can't figure out how to do it. i thought all i had to do was create a new function at the bottom "defaultfolder" then say initdir=defaultfolder but it's not working. can you or someone else help me out with this last bit. thanks

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Setting initial open directory to folder with given name
« Reply #7 on: March 22, 2007, 09:02:54 AM »
Add this function to the CommonDialog module as a seperate function
Code: [Select]
Private Function FindPath (ByVal path As String) As String
Dim X As Integer
For X = 67 to 69
   rVal = Dir(Chr(X) & ":\" & path & "\*.*")
   If rVal <> "" Then
     FindPath = Chr(X) & ":\" & path
     X = 70
   Else
     FindPath = "C:\"
   End If
Next X
End Function

Now, in your CommonDialog function, add (at the very beginning before showing the form)
Code: [Select]
MyOpen.InitDir = FindPath ("path\to\files\no\leading\or\trailing\backslashes")
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

ELOQUINTET

  • Guest
Re: Setting initial open directory to folder with given name
« Reply #8 on: March 22, 2007, 10:11:02 AM »
yikes keith i'm still not getting it. this routine utilizes the CommonDialog.dvb so that's where I put the bit you gave me(see below). The second bit is what i'm not clear on. This line was originally in the other file called Updateattribute. I tried putting it at the beginning but i'm not sure i understand what you meant by

"at the very beginning before showing the form"

I'm confused  :oops:

Code: [Select]
Option Explicit

Public Function Init() As CommonDialog
Set Init = New CommonDialog
End Function
Private Function FindPath(ByVal path As String) As String
Dim X As Integer
For X = 67 To 69
   rVal = Dir(Chr(X) & ":\" & path & "\*.*")
   If rVal <> "" Then
     FindPath = Chr(X) & ":\" & path
     X = 70
   Else
     FindPath = "C:\"
   End If
Next X
End Function

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Setting initial open directory to folder with given name
« Reply #9 on: March 22, 2007, 10:21:16 AM »
oh .. so they are in different modules .. put the FindPath function in the same module as the code for your common dialog ... ie he same module where you will be calling it from.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

ELOQUINTET

  • Guest
Re: Setting initial open directory to folder with given name
« Reply #10 on: March 22, 2007, 10:51:50 AM »
Uggggh I feel so retarded. I have a file called updateattribute.dvb which references the commondialogue.dvb file. I have taken your bits out of common and put them at the end of update file. I am still not sure where to place the init.dir line? I am just not sure what you mean by put it at the beginning because i recall that vba doesn't read top to bottom like lisp. I'm going to post the whole code so you can see what I see?

Code: [Select]
Option Explicit

'Stores block names & attributes for 1st inserted block of each
Public AllBlocks As Scripting.Dictionary

'Stores attributes for selected block
Public AllAttribs As Variant

'Macro for user interface
Public Sub Ua()
  Dim myFiles As Variant 'Stores filenames selected in array
  myFiles = GetFiles 'Store filenames selected by user in array
 
  'AllBlocks is a public variable
  Set AllBlocks = New Scripting.Dictionary 'Initialize storage
  BlockDialog.BlockPicked = "" 'Initialize check variable
  Set AttribDialog.AttribPicked = Nothing 'Initialize check variable
  TextDialog.DoUpdate = False 'Initialize check variable
 
  'If files are selected
  If IsArray(myFiles) Then
    Dim myDoc As AcadDocument 'Need a variable for a drawing
    'Get the first drawing selected by user
    Set myDoc = AcadApplication.Documents.Open(myFiles(0))
    GetBlocks myDoc, AllBlocks 'Get all attributed blocks in dwg
  End If
 
  'There may be no attributed blocks, so need to test
  If AllBlocks.Count > 0 Then BlockDialog.Show 'Show list of blocks
 
  'If a block was selected
  If BlockDialog.BlockPicked <> "" Then
    'Store attributes from selected block in public variable
    AllAttribs = AllBlocks.Item(BlockDialog.BlockPicked)
    AttribDialog.Show 'Show list of attributes
  End If
 
  'If an attribute was selected
  If Not (AttribDialog.AttribPicked Is Nothing) Then
    TextDialog.Show 'Display dialog to get new string
  End If
 
  'If OK was hit in the TextDialog
  If TextDialog.DoUpdate Then
    'Change all the drawings the user selected
    ProcessDrawings myFiles, _
                    BlockDialog.BlockPicked, _
                    AttribDialog.AttribPicked.TagString, _
                    TextDialog.NewText
   
    'Inform the user things are done
    MsgBox "Process is complete.", vbOKOnly, "ABC's of VBA"
  Else
    myDoc.Close False 'Close drawing left open during cancel
  End If
End Sub

'Open all given drawings and change selected attribute
Private Sub ProcessDrawings(ByVal Dwgs As Variant, _
                            ByVal BlockName As String, _
                            ByVal TagName As String, _
                            ByVal NewText As String)
  'The following creates a selection set filter
  Dim fType(0 To 1) As Integer 'Stores DXF-style codes
  Dim fData(0 To 1) As Variant 'Stores filters
  fType(0) = 0: fData(0) = "INSERT" 'Filter for block insertions
  fType(1) = 2: fData(1) = BlockName 'Filter for specific block
 
  Dim openFilename As String 'Stores name of open drawing
  Dim myDwg As AcadDocument 'Stores each drawing in turn
  Dim mySS As AcadSelectionSet 'Stores selection set
  Dim myAtts As Variant 'Stores attributes for each insertion
  Dim i As Long, j As Long 'Declare two counters
 
  For i = 0 To UBound(Dwgs) 'Loop thru all drawings
    openFilename = GetOpenFilename(Dwgs(i)) 'Checks if file is open
    'If the drawing is open, just refer to open drawing
    If openFilename <> "" Then
      Set myDwg = AcadApplication.Documents.Item(openFilename)
    Else 'Open the drawing
      Set myDwg = AcadApplication.Documents.Open(Dwgs(i))
    End If
   
    Set mySS = GetSS(myDwg) 'Get a selection set
   
    'Populate the selection set with specified block insertions
    mySS.Select Mode:=acSelectionSetAll, _
                FilterType:=fType, _
                FilterData:=fData
               
    For j = 0 To mySS.Count - 1 'Loop thru all selected blocks
      ChangeAttrib mySS.Item(j), TagName, NewText 'Change attribute
    Next j
   
    mySS.Delete 'Always delete a selection set when done with it
    myDwg.Close Not myDwg.ReadOnly 'Close drawing, saving changes
  Next i
End Sub

'Checks to see if the given fully-qualified filename is open
'Returns the filename without path if it is open
Private Function GetOpenFilename(fqnName As Variant) As String
  Dim i As Long 'Declare a counter
  'Loop thru all open drawings
  For i = 0 To AcadApplication.Documents.Count - 1
    'Use the document given below for its properties
    With AcadApplication.Documents.Item(i)
      'Compare two strings, if they match (equal 0) then return Name
      If StrComp(.FullName, fqnName, vbTextCompare) = 0 Then
        GetOpenFilename = .Name
        Exit For 'Since a match was found, exit the loop
      End If
    End With
  Next i
End Function

'Returns a named selection set
Private Function GetSS(ByRef theDoc As AcadDocument, _
                       Optional ByVal Name As String = "mySS") _
                       As AcadSelectionSet
  'Enable error handling, but just skip the error
  On Error Resume Next
  'Attempt to get the named selection set
  Set GetSS = theDoc.SelectionSets.Item(Name)
  GetSS.Clear 'Clear the selection set of any items
  'If this error occurred, the selection set didn't exist, create it
  If Err.Number = 91 Then Set GetSS = theDoc.SelectionSets.Add(Name)
End Function

'Change the given attribute in the given block reference
Private Sub ChangeAttrib(ByVal theBlock As AcadBlockReference, _
                         ByVal TagName As String, _
                         ByVal NewText As String)
  Dim myAtts As Variant 'GetAttributes returns an array
  myAtts = theBlock.GetAttributes 'Get the attributes
 
  Dim i As Long 'Declare a counter
  For i = 0 To UBound(myAtts) 'Loop thru all attributes
    With myAtts(i) 'For each attribute
      'If the current attribute is the correct one
      If .TagString = TagName Then
        .TextString = NewText 'change the attributes value
        Exit For 'Exit the loop, we are done
      End If
    End With
  Next i
End Sub

'Returns all the attributed inserted blocks in a drawings layouts
Private Function GetBlocks(ByVal theDoc As AcadDocument, _
                           ByRef BlockStore As Scripting.Dictionary)
  'Set dictionary's comparison mode to work with text
  BlockStore.CompareMode = TextCompare
 
  Dim aEntity As AcadEntity 'Stores each entity in turn
  Dim aLayout As AcadLayout 'Stores each layout in turn
  Dim aBlkRef As AcadBlockReference 'Stores a block reference
  For Each aLayout In theDoc.Layouts 'Loop thru all the layouts
    'The below condition is for performance, it excludes ModelSpace
    If Not (aLayout.ModelType) Then
      For Each aEntity In aLayout.Block 'Loop thru all entities
        'If the current entity is a block insertion
        If TypeOf aEntity Is AcadBlockReference Then
          Set aBlkRef = aEntity 'Cast the entity into a block ref
          'If the block insertion has attributes
          If aBlkRef.HasAttributes Then
            'Use a procedure to add block to dictionary
            'Need procedure for isolated error handling
            AddBlock BlockStore, aBlkRef.Name, aBlkRef.GetAttributes
          End If
        End If
      Next aEntity
    End If
  Next aLayout
End Function

'Adds a block name and its attributes to a dictionary
Private Sub AddBlock(ByRef BlockStore As Scripting.Dictionary, _
                     ByVal Name As String, _
                     ByVal Attribs As Variant)
  'Enable error handling, but just skip the error
  On Error Resume Next
  'Attempt to add block name and its attributes to the dictionary
  'If the block name already exists in the dictionary,
  'an error occurs. So this procedure just skips the duplicate.
  BlockStore.Add Name, Attribs
End Sub

'Display an open dialog, adds selected files to an array
Private Function GetFiles() As Variant
  'Stores the object created by the CommonDialog class
    Dim myOpen As CommonDialogProject.CommonDialog
  Set myOpen = CommonDialogProject.Init 'Create the object
 
  myOpen.DialogTitle = "Select drawings" 'Change the title
  myOpen.Filter = "AutoCAD Drawing files (*.dwg)|*.dwg|" & _
                          "AutoCAD Drawing template files (*.dwt)|*.dwt"
    myOpen.DefaultExt = "dwg"
  'Set flags to limit behavior of the dialog box
  myOpen.Flags = OFN_ALLOWMULTISELECT + _
                 OFN_EXPLORER + _
                 OFN_FILEMUSTEXIST + _
                 OFN_HIDEREADONLY + _
                 OFN_PATHMUSTEXIST
   myOpen.InitDir = FindPath("path\to\files\no\leading\or\trailing\backslashes")
   myOpen.MaxFileSize = 2048 'Increase buffer of filenames
 
  Dim success As Long 'Stores the return value from CommonDialog
  success = myOpen.ShowOpen 'Display the open dialog box
  'If the dialog was not cancelled get array of filenames
  If success > 0 Then GetFiles = myOpen.ParseFileNames
End Function
Private Function FindPath(ByVal path As String) As String
Dim X As Integer
For X = 67 To 69
   rVal = Dir(Chr(X) & ":\" & path & "\*.*")
   If rVal <> "" Then
     FindPath = Chr(X) & ":\" & path
     X = 70
   Else
     FindPath = "C:\"
   End If
Next X
End Function

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Setting initial open directory to folder with given name
« Reply #11 on: March 22, 2007, 11:00:45 AM »
What you have there should work, provided you change the path to the drawings folder on each computerer .. minus a drawing name and minus a drive letter ... thus if the path to your drawings is:

"C:\Program Files\Stored Data\Drawings\"

you would use
Code: [Select]
MyOpen.InitDir = FindPath ("Program Files\Stored Data\Drawings")

It will then return either "C:\" as the initial folder or "[drive letter]:\Program Files\Stored Data\Drawings" as the initial folder

Does that make more sense?
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

ELOQUINTET

  • Guest
Re: Setting initial open directory to folder with given name
« Reply #12 on: March 22, 2007, 11:32:15 AM »
Keith the only difference in the paths is the drive letter. The folder is the same so I tried puting this:

myOpen.InitDir = FindPath("\Drawings")

when i run it i get this message:

compile error
variable not defined
and rVal is highlighted

also when you say i need to change the path to the drawings folder on each computer what do you mean? the point of this is for it to find the drawings folder regardless of what drive it is located on no?

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Setting initial open directory to folder with given name
« Reply #13 on: March 22, 2007, 11:37:54 AM »
add
Code: [Select]
Dim rVal As String
to the "findpath" function right after the Dim X as Integer line

Then change your function call to ..
Code: [Select]
myOpen.InitDir = FindPath("Drawings")

If you look at the example I provided you will see I said to leave off the beginning backslash and the ending backslash
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

ELOQUINTET

  • Guest
Re: Setting initial open directory to folder with given name
« Reply #14 on: March 22, 2007, 11:44:39 AM »
ah yes it worked. i removed the backslash after i posted last. i will have to go over to the girls computer who has her drawings in a different drive and test it. thanks a bunch man this has been a good learning experience. i'll let you know how it goes