ACADApp_Beginquirt事件

Private Sub AcadDocument_BeginClose()
If Documents.Count = 1 Then
 SysVarName = "WSCURRENT"
 CurrSysVarData = ThisDrawing.GetVariable(SysVarName)
 NewSysVarData = "Exit"
 
  If CurrSysVarData  "Exit" Then
    ThisDrawing.SetVariable SysVarName, NewSysVarData
    If MsgBox("Would you like to save this drawing?", vbYesNo) = vbYes Then
     ThisDrawing.Save
     Application.Quit
    Else
     Application.Quit
     Exit Sub
    End If
  End If
End If
End Sub

Sub Acadstartup()
Dim Username As Variant
Dim WshNetwork As Variant
Dim Preferences As AcadPreferences
Dim ActProfile As String
Dim CurrMenuPath As String
Dim CurrMenuFile As String
Set WshNetwork = CreateObject("WScript.Network")
Set Preferences = ThisDrawing.Application.Preferences
Username = WshNetwork.Username
ActProfile = Preferences.Profiles.ActiveProfile
CurrMenuPath = "C:\Documents and Settings" & Username & "\Application Data\Autodesk\Autodesk Land Desktop 2006\R16.2\enu\Support"
CurrMenuFile = Preferences.Files.MenuFile
If ActProfile = "Land Desktop" Then
 CurrMenuFile = CurrMenuPath & "land"
 ThisDrawing.SetVariable "wscurrent", "Land Destop Complete"
Else
 If ActProfile = "MapLandDevelopmentDesktop" Then
 CurrMenuFile = CurrMenuPath & "acmap"
 ThisDrawing.SetVariable "wscurrent", "Map Classic"
End If
End If
 
End Sub