BatchPurge.Exe is a stand alone application written in Visual Basic for
AutoCAD Release 14.
This routine will Batch Purge (Purge All) a selected directory of
drawings.
If AutoCAD is not open when you run the application, it will automatically
open AutoCAD. You can also run it from within Autocad.
Usage :
Open the application by double clicking on BatchPurge.Exe.
A dialogue box will appear. Select the directory where the drawings you
wish to Purge reside. Select "OK".
If you wish to run it from within AutoCAD type the following at the
command prompt :
(startapp "....directory path..../batchpurge.exe")
The VBA Code
The following must be placed under the event procedure of the Drive
List Box:
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
'retrieves the drive name
End Sub
Next, place this coding under the event procedure of the Directory List
Box:
Private Sub Dir1_Change()
File1.Path = Dir1.Path
'retrieves the drive and directory name
End Sub
The main routine of the function is within the event procedure of the
"Start Purge" button :
Private Sub Command1_Click()
Dim acadApp As Object
Dim acadDoc As Object
Dim filename As String
Dim dirname As String
'declare variables
If Right(File1.Path, 1) <> "\" Then
'test for root directory
dirname = File1.Path & "\"
'if not root add \
Else
dirname = File1.Path
'if root directory do nothing
End If
If UCase(dirname) = "A:\" Then
'check if A:Drive has been choosen
Me.Hide
'Hide the dialogue box
MsgBox ("Insufficient Space to Batch Purge Drawings on Drive A:"),_
16, "Batch Purge"
'inform the user
End
'end the application
End If
On Error Resume Next
'if error carry on with next line
Set acadApp = GetObject(, "AutoCAD.Application")
'setq reference to AutoCAD Application
If Err Then
'if there is an error (AutoCAD not open)
Err.Clear
'clear the error
Set acadApp = CreateObject("Autocad.Application")
'open AutoCAD
Set acadApp = GetObject(, "AutoCAD.Application")
'setq reference to AutoCAD Application
If Err Then
'if there is another error
MsgBox Err.Description
'inform user
Exit Sub
'exit application
End If
End If
acadApp.Visible = True
'Make Autocad Visible
Set acadDoc = acadApp.ActiveDocument
'set reference to active document
Me.Hide
'Hide the dialogue box
filename = Dir(dirname, vbNormal)
'retrieve the first entry
Do While filename <> ""
'start the loop
If UCase(Right$(filename, 4)) = ".DWG" Then
'ignore files that do not end with .DWG
If (GetAttr(dirname & filename) And vbNormal) = vbNormal Then
'use bitwise comparison to make sure filename is not a directory
If Not acadDoc.Saved Then
'if drawing not saved
If MsgBox("OK to Save Drawing?", 52, "Batch Purge") = vbNo Then
'give user choice to save drawing and continue, or exit application
End
'end if user selects No
Else
'or else
acadDoc.Save
'if Yes, save drawing
End If
End If
acadDoc.Open dirname & filename
'open drawing to purge
acadDoc.PurgeAll
'purge the drawing
acadDoc.Save
'save the drawing
End If
End If
filename = Dir
'get the next entry
Loop
'carry on looping
acadApp.Quit
'Close Autocad
MsgBox ("Batch Purge Complete"), , "Purge All"
'inform user that we have finished
End
'Close VBA Application
End Sub
Finally, this coding goes under the event procedure of the
"Cancel" button :
Private Sub btnCancel_Click()
End
'end the routine
End Sub
|