'在正常退出情况下也保留自动保存文件
Private Sub AcadDocument_BeginDocClose(Cancel As Boolean)
    'On Error Resume Next
    Dim File As String
    Dim NewFile As String
    '系统自动保存的文件名
    File = ThisDrawing.GetVariable("SAVEFILE")
    If File = "" Then Exit Sub
    Dim FileName As String
    FileName = GetFileName(File)
    NewFile = GetPath & "DWG_Back\" & FileName
    NewFile = Left(NewFile, Len(NewFile) - 4) & "_TC.dwg"
    If Dir(GetPath & "DWG_Back\") = "" Then
        MkDir GetPath & "DWG_Back\"
    End If
    Name File As NewFile '重新命名一个文件、目录、或文件夹。
End Sub