Is it really possible to rename an opened file? Normally the operating system will not allow you to do that. But it is REALLY possible to do it inside AutoCAD by adapting a tricky way as explained below. Here are the steps involved in the process.
- Get the new drawing name from the user
- Check any drawing is existing in the current folder with the name provided.
- If not, save and close the current drawing and copy it in the new drawing name.
- After verification, delete the old file.
- Open the copied file in AutoCAD
Though it seems like a long procedure, practically it all finish within a moment. The user never get the feeling of all those background processing. Users are encouraged to set system variable ISAVEBAK to 1 in order to eliminate the chances of possible data loss due to any unexpected errors. The following is an implimentation of above logic in AutoCAD VBA
'*****************************************************************
'<-- Active Drawing Renaming Utility -->
'<-- Renames the current drawing from the command prompt. -->
'<-- By Mohamed Haris (zoomharis@gmail.com) -->
'*****************************************************************
Sub RenameOnline()
On Error GoTo ErrDet
Dim objFS, objFL As Object
Dim strFilePath As String, strNewFileName As String, strNewFileFullName As String
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFL = objFS.getfile(ThisDrawing.FullName)
strFilePath = ThisDrawing.Path
strNewFileName = ThisDrawing.Utility.GetString(True, vbCr & "Enter new file name to rename: ")
strNewFileFullName = strFilePath & "\" & strNewFileName & ".dwg"
'*** Check for a valid windows filename
If Not FileNameIsValid(strNewFileName) Then
MsgBox "Please provide a valid name to rename....", vbExclamation
GoTo ClearMem
ElseIf objFS.fileExists(strNewFileFullName) Then
MsgBox "A file with new filename already exists...!!!" & vbCrLf & _
"Please check the existing filenames...", vbExclamation
GoTo ClearMem
Else
ThisDrawing.Save
objFL.Copy (strNewFileFullName), False
End If
'*** Make sure that the file has been copied before deleting the old one
If objFS.fileExists(strNewFileFullName) Then
ThisDrawing.Close True
objFL.Delete
Application.Documents.Open strNewFileFullName
Else
MsgBox "Couldn't rename the file. Please try again...!!!", vbExclamation
End If
ErrDet:
If Err.Number <> 0 Then
MsgBox "An error occured while renaming the file....!!!" & vbCrLf & vbCrLf & _
"Error Description: " & vbCrLf & Err.Description, vbExclamation
End If
ClearMem:
Set objFL = Nothing
Set objFS = Nothing
End Sub
'*** NOTE: A regular expression could serve better for this purpose
Function FileNameIsValid(ByVal strFileName As String) As Boolean
Dim i As Integer
If Trim(strFileName) = "" Then
FileNameIsValid = False
Exit Function
End If
arInvalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "")
For i = 0 To UBound(arInvalidChars) - 1
If InStr(1, strFileName, arInvalidChars(i), vbTextCompare) <> 0 Then
FileNameIsValid = False
Exit Function
End If
Next
FileNameIsValid = True
End Function
Normally I don't provide the new file name in the command prompt. Instead, there is another VBA routine which takes the the drawing name attribute value from the title blocks and provide it as the input for the RenameOnline utitlity. You could also implement this logic in any of your favourite programming languages.
No comments:
Post a Comment