AutoCAD 2010/2011/2012 DWG Format
I finally have a solution 
The steps are as follow:
- Remove the hidden blocks
- Remove registered applications
- export the dwg as a dxf format
- close the dwf file
- reopen the dxf file
- purge the file
- save back as dwg
See below my final codes for the entire directory:
Sub PurgeEverything()
'Make sure that you also have a blank drawing open in the backgroung
'A Sub Folder "export" in the MyPath Directory must be present
Dim MyFile, MyPath, MyName
MyPath = "C:\Directory\" ' Set the path.
' Returns filename with specified extension. If more than one *.ini
' file exists, the first file found is returned.
MyFile = Dir(MyPath + "*.dwg")
' Call Dir again without arguments to return the next *.INI file in the
' same directory.
Do While MyFile <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyFile <> "." And MyFile <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(MyPath & MyFile) And vbDirectory) = vbDirectory Then
Debug.Print MyFile ' Display entry only if it
End If ' it represents a directory.
End If
''open the drawing
ThisDrawing.Application.Documents.Open (MyPath + MyFile)
'Wait for a second
SendKeys "{ESC}", True
Dim PauseTime, Start, Finish, TotalTime
PauseTime = 1 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
''Purge all the blocks
'Sub PurgeBlocks()
Dim ssBlocks As AcadBlocks
Dim oObj As Object
Dim oBlock As AcadBlock
Set ssBlocks = ThisDrawing.Blocks
Debug.Print "There are ", ssBlocks.Count, " blocks in the drawing database"
For Each oObj In ssBlocks
If TypeOf oObj Is AcadBlock Then
Set oBlock = oObj
Debug.Print oBlock.Name,
If oBlock.IsLayout = False Then
On Error Resume Next
oBlock.Delete
If Err <> 0 Then
Debug.Print Err.Description
Err.Clear
Else
Debug.Print "has been purged"
End If
Else
Debug.Print
End If
On Error GoTo 0
End If
Next
''Regapps
'Verify registered apps when drawing loads
'Private Sub VerifyRegistered_Apps()
Dim oRegApp As AcadRegisteredApplication
Dim oRegApps As AcadRegisteredApplications
Dim colBadApps As Collection
Dim strMSG As String
Dim i As Integer
'get the current collection of registered apps
Set oRegApps = ThisDrawing.RegisteredApplications
' start a new collection for bad apps
Set colBadApps = New Collection
' review each registered application
For Each oRegApp In oRegApps
'Debug.Print oRegApp.Name
' if there's a "*" in the name, **** good chance it's BAD!
If InStr(1, oRegApp.Name, "*") > 0 Then
colBadApps.Add oRegApp.Name
End If
Next
' if we found some bad apps, report them!
If colBadApps.Count > 0 Then
'build list of bad ones
For i = 1 To colBadApps.Count
strMSG = strMSG & colBadApps.Item(i) & vbNewLine
Next
'display the bad news
MsgBox "There's a good chance this drawing has corruputed data!" & vbNewLine & _
"INVALID REGISTERED APPS FOUND!" & vbNewLine & _
strMSG
End If
Set colBadApps = Nothing
Set oRegApp = Nothing
Set oRegApps = Nothing
''Purge the drawing
ThisDrawing.PurgeAll
Dim FileName As String
Dim FileLoc As String
Dim FullPath As String
Dim NewFullPath As String
''Export the drawing as a dxf
FileLoc = ThisDrawing.Path
FileName = ThisDrawing.Name
FullPath = FileLoc + "\export\" + FileName
ThisDrawing.SaveAs FullPath, ac2010_dxf
NewFullPath = ThisDrawing.Path + "\" + ThisDrawing.Name
''Close the drawing
ThisDrawing.Close
''Reopen the dxf drawing
ThisDrawing.Application.Documents.Open (NewFullPath)
'Wait for a second
SendKeys "{ESC}", True
PauseTime = 1 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
'' Purge the drawing
ThisDrawing.PurgeAll
''Save the dxf as dwg
ThisDrawing.SaveAs FullPath, acNative
ThisDrawing.Close
MyFile = Dir ' Get next drawing entry.
Loop
End Sub
