zeng29 发表于 2003-10-13 20:33:00

没有问题

这是原代码

gzy 发表于 2003-10-13 20:50:00

本帖最后由 作者 于 2003-10-13 21:12:24 编辑

多谢整理啊，如果CAD开着，那么CAD将打开所有处理的文件。但是关了就没有什么问题了,还有我始终找不到处理的文件，所以显示处理后为0，收索整个硬盘也找不到处理的文件，
再次多谢！

zeng29 发表于 2003-10-14 11:01:00

AutoCAD有时将盘符大写.
加了Lcase函数应该可以:
Private Sub cmddo_click()
    On Error Resume Next
    Size = 0
    If File1.ListCount = 0 Then Exit Sub
    Set AcadApp = GetObject(, "AutoCAD.application")
    If Err Then
      NewApp = True
      Err.Clear
      Set AcadApp = CreateObject("AutoCAD.application")
      If Err Then
            MsgBox Err.Description
            Exit Sub
      End If
    End If
    If Right(Dir1.Path, 1) <> "\" Then
      Path = Dir1.Path & "\"
    Else
      Path = Dir1.Path
    End If
    For i = 0 To File1.ListCount - 1 Step 1
      If File1.Selected(i) Then '对列表文件进行处理
            a = Path + File1.List(i)
            File1.Selected(i) = False
            AcadApp.documents.open a
            If Err Then
                Err.Clear
                MsgBox Err.Description
            End If
            On Error GoTo 0 '关闭错误陷井,以便调试后续语句.
            For Each CurDoc In AcadApp.documents
                If LCase(CurDoc.FullName) = LCase(a) Then
                  CurDoc.PurgeAll
                  CurDoc.PurgeAll
                  CurDoc.PurgeAll
                  CurDoc.PurgeAll
                  OutFileName = Path & "S_" & File1.List(i)
                  If Dir(OutFileName) = "" Then
                        CurDoc.SaveAs OutFileName
                  ElseIf MsgBox("文件已经存在:" & vbCrLf & OutFileName & vbCrLf & "要替换它吗?", vbYesNo) = vbYes Then
                        CurDoc.SaveAs OutFileName
                  End If
                  CurDoc.Close
                  Size = Size + FileLen(OutFileName)
                  Exit For
                End If
            Next CurDoc
      End If
    Next i
    Text2.Text = Str(Size)
    If NewApp = True Then AcadApp.quit
    File1.Refresh
    Set AcadApp = Nothing
End Sub

zeng29 发表于 2003-10-14 11:38:00

这个是编译后的文件:(5K)

myfreemind 发表于 2003-10-15 23:25:00

不错！

zchuier 发表于 2003-10-17 10:34:00

CurDoc.SaveAs Dir1.Path & "\S_" & File1.List(i)
这条语句少了一个“\”加上就好了，似乎确实是起到了“减肥”的作用。

zeng29 发表于 2003-10-17 13:17:00

zchuier发表于2003-10-17 10:34:00static/image/common/back.gifCurDoc.SaveAs Dir1.Path & &quot;\S_&quot; & File1.List(i)
这条语句少了一个“\”加上就好了，似乎确实是起到了“减肥”的作用。


如果这样的话,文件名就是错误的!!!
你没有仔细查看前面的代码:
    If Right(Dir1.Path, 1) <> "\" Then
      Path = Dir1.Path & "\"
    Else
      Path = Dir1.Path
    End If
之所以这样是因为根目录下Path具有"\"(如"C:\"),而子目录下没有"\"(如"C:\Winnt").

zgyxn 发表于 2003-10-20 12:39:00

好像还是空文件

slsldu 发表于 2003-11-22 09:08:00

zeng29 发表于 2003-11-22 10:27:00

不会吧,有听说过AutoCAD的"清理"命令将文件"清理"大的吗?
这个VB程序原理上只是调用了AutoCAD的"清理"而已.
页: 1 [2]
查看完整版本: [分享]特此上传*DWG减肥工具所有部分