Tuesday, October 2, 2007

Renaming an Active Drawing from the Command Prompt

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.

  1. Get the new drawing name from the user

  2. Check any drawing is existing in the current folder with the name provided.

  3. If not, save and close the current drawing and copy it in the new drawing name.

  4. After verification, delete the old file.

  5. 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
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
Application.Documents.Open strNewFileFullName
MsgBox "Couldn't rename the file. Please try again...!!!", vbExclamation
End If
If Err.Number <> 0 Then
MsgBox "An error occured while renaming the file....!!!" & vbCrLf & vbCrLf & _
"Error Description: " & vbCrLf & Err.Description, vbExclamation
End If
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
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: