一个使ACAD文件瘦身50%以上的方法

[SmartSoft]

最近对SmartSoft数据库进行整理，主要是针对上传到电子保险箱的工程图纸进行整理。发现工程图纸占用了服务器大量的磁盘空间，
使得服务器磁盘空间告急。针对此问题，我们进行了研究，经过大约一周的努力，使得工程图纸占用的磁盘空间减少了50%多，现把处理过程及ACAD处理程
序（VBA）发布如下，供大家参考。
处理思路主要从两方面考虑：
1、把所有的ACAD文件存储为ACAD 2004以上格式，AutoDesk声称节省40%以上的空间，情况属实，具体大家可以Google
一下相关信息；
2、利用Purge命令清除图形中未使用的、可被清理的命名对象，这个命令节省的空间柔性很大，具体大家可以Google一下相关信息；
3、更新了关于菜单的Save相关的命令，使在执行保存命令前先执行一次2操作；

VBA程序如下：
FORM控件如下：
TextBox--tbPath
CommandButton--cbPurge
ListBox--ListBox1
Label--LabTips

Private Sub cbPurge_Click()
Dim Fso As New FileSystemObject
Dim RootFolder As Folder

If Fso.FolderExists(Me.tbPath.Text) = False Then
Me.LabTips.Caption = "目录不存在。"
Exit Sub
End If
Set RootFolder = Fso.GetFolder(Me.tbPath.Text)

GetFolder RootFolder

Me.LabTips.Caption = "共计处理 " + Me.ListBox1.ListCount + " 个文件"

End Sub

Private Sub PurgeDrawing(oFolder As Folder)
On Error Resume Next
Dim Fso As New FileSystemObject
Dim oFile As File
Dim Ext As String
For Each oFile In oFolder.Files
Ext = Fso.GetExtensionName(oFile.Path)
If LCase$(Ext) = "dwg" Then
Me.LabTips.Caption = "正在处理" + oFile.Path
Application.Documents.Open (oFile.Path)

Dim i As Integer
For i = 0 To 10
Application.ActiveDocument.SendCommand ("_purge" &
vbCr & "all" & vbCr & "*" & vbCr & "n" & vbCr)
Next i
Application.ActiveDocument.Save
Application.ActiveDocument.Close

Me.ListBox1.AddItem oFile.Path
Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1
Me.ListBox1.Selected (Me.ListBox1.ListCount - 1)
Me.Repaint
End If
Next oFile
End Sub

Private Sub GetFolder(oFolder As Folder)
On Error Resume Next
Dim Fso As New FileSystemObject
Dim oDir As Folder

PurgeDrawing oFolder
If oFolder.SubFolders.Count > 0 Then
For Each oDir In oFolder.SubFolders
GetFolder oDir
Next oDir
End If
End Sub