TheSwamp
Code Red => VB(A) => Topic started by: ELOQUINTET 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
-
If the path is the same you can simply iterate through all drives.
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
-
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?
-
sure ...
For X = 67 to 69
rVal = Dir(chr(X) & ":\Mypath\MyFile.ext")
If rVal <> "" Then
X = 70
End If
Next X
-
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?
'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
-
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
-
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
-
Add this function to the CommonDialog module as a seperate 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
Now, in your CommonDialog function, add (at the very beginning before showing the form)
MyOpen.InitDir = FindPath ("path\to\files\no\leading\or\trailing\backslashes")
-
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:
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
-
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.
-
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?
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
-
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
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?
-
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?
-
add
Dim rVal As String
to the "findpath" function right after the Dim X as Integer line
Then change your function call to ..
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
-
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
-
Ughh Keith :cry: It sort of worked. Here's the deal when I tried it it opened to a folder called Drawings but when I expanded she also had a drawings folder on her C:. I looked inside it and there was one file so I moved it to the folder on her E: and deleted the drawings folder from her C:. Now when I run the routine I get this message:
Bad file name or number
What do I need to fix this?
-
a simple fix in the FindPath function add an error handler ..
On Error Resume Next
Well, not really an error handler .. but it does the same ...
Put it right after the Dims in the function
-
yeeeeessss thank you thank you thank you Keith it works now. I have a question to ask about VBA in general now. I have several file which load from acad.lsp for all of my users, this being one of them. Everytime I need to make a change I have to save it as something else which isn't bas as I am still in the very early learning stages. Once I get it working however I want to be able to Save it as the original without having to have everyone exit Autocad. Is this possible or am I just going about loading things wrong?
-
If the dvb is loaded you cannot overwrite it while they are using it (with lisp you can)...
You could create a lisp in the acad.lsp file that copies the file to the local hard drive, then whenever you open up a drawing, it copies the dvb over so they always have the newest file. You will need to make the lisp unload the dvb and reload it.
-
hmmm interesting thought. at this point i don't have and am not modifying vba stuff enough to warrant this but maybe eventually thanks again keith for your help with this