AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Batch Purge (7 Kb)

Batch Purge

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
 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website