[分享]*.dwg文件减肥程序

gzy

曾经在一本期刊上看到：对于复杂大的图形，实际是可以将它的大小减小的，因为它记录了很多用户曾经做过的操作。尽管可以使用PURGE进行清理，但如果有一大批的图纸要一个一个清理那就相当麻烦了，如果能批量的处理就更好了。于是小弟就将它做出来了，现将代码传上来供大家学习和提供意见（用VB做的，如果那位大哥想要源程序的话请EMAIL告知）
Public Path
Private Sub cmddo_click()
   Size = 0
   On Error Resume Next
   Set acadapp = GetObject(, "AutoCAD.application")
   If Err Then
     Err.Clear
     Set acadapp = CreateObject("AutoCAD.application")
        If Err Then
           MsgBox Err.Description
           Exit Sub
        End If
   End If
Set acaddoc = acadapp.activedocument
For i = 0 To File1.ListCount - 1 Step 1
  If File1.Selected(i) Then '对列表文件进行处理
    a = Path + File1.List(i)
    File1.Selected(i) = False
    acaddoc.apen a
    acaddoc.activeviewport.zoomall
    acaddoc.purgeall
    acaddoc.purgeall
    acaddoc.purgeall
    acaddoc.purgeall
    acaddoc.purgeall
     MkDir "d:\jianfei"
    acaddoc.saveas "d:\jianfei\" & File1.List(i) & ".dwg"
    Size = Size + FileLen("d:\jianfei\" & File1.List(i) & ".dwg")
  End If
Next i
Text2.Text = Str(Size)
  acadapp.quit
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdselall_Click() '计算大小
For i = 0 To File1.ListCount - 1 Step 1
   File1.Selected(i) = True
   Next i
   Text1.Text = cal_size
End Sub

Private Sub dir1_change()
Text2.Text = ""
End Sub
Private Sub Dir1_click()
  Dir1.Path = Dir1.List(Dir1.ListIndex)
  Path = Dir1.Path
  If Right$(Path, 1) <> "\" Then
    Path = Path + "\"
    End If
    File1.Path = Path
    Text1.Text = ""
    Text2.Text = ""
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
Dir1_click
End Sub
Private Function cal_size() As String '计算当前的文件大小
Dim len1 As Long
len1 = 0
For i = 0 To File1.ListCount - 1 Step 1
  If File1.Selected(i) Then
    len1 = len1 + FileLen(Path + File1.List(i))
  End If
Next i
cal_size = Str(len1)
End Function
Private Sub file1_mouseup(button As Integer, shift As Integer, X As Single, Y As Single)
  Text1.Text = cal_size
End Sub

mccad

象这样的清理可能不能将以前的绘图记录清除吧。应该清理后把图形全选，然后输出为图块，但这样的输出有一个缺点，就是如果用户有使用布局时这种输出图块不能将布局也输出。

efan2000

使用acaddoc.save达不到减肥的效果，因为在ACAD中的图形是以增量方式保存的，默认的是50%。
应该要先使用acaddoc.saveas另存为一个临时文件，然后再更改它的文件名。

gzy

多谢明总及版主的指点。现在已经做好了。