取消定义/重定义外部参照

Option Explicit
Dim CurUCS As AcadUCS
Dim CurLayer As AcadLayer
Dim UCSs As Object
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
    Set CurUCS = ThisDrawing.ActiveUCS
    Set CurLayer = ThisDrawing.ActiveLayer
    Call ShowWCS
    ThisDrawing.Layers("0").Freeze = False
    ThisDrawing.Layers("0").LayerOn = True
    ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
End If
End Sub
Sub ShowWCS()
'
'   Display WCS
'
    Dim wcs As Object
    Dim dorigin(0 To 2) As Double
    Dim dxAxisPnt(0 To 2) As Double
    Dim dyAxisPnt(0 To 2) As Double
        
    dorigin(0) = 0#
    dorigin(1) = 0#
    dorigin(2) = 0#
    
    dxAxisPnt(0) = 1#
    dxAxisPnt(1) = 0#
    dxAxisPnt(2) = 0#
    
    dyAxisPnt(0) = 0#
    dyAxisPnt(1) = 1#
    dyAxisPnt(2) = 0#
    
    Set wcs = ThisDrawing.UserCoordinateSystems.Add(dorigin, dxAxisPnt, dyAxisPnt, "WORLD")
'    Display WCS.
    ThisDrawing.ActiveUCS = wcs
    
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
    ThisDrawing.ActiveUCS = CurUCS
    ThisDrawing.ActiveLayer = CurLayer
    ThisDrawing.UserCoordinateSystems.Item("World").Delete
End If
End Sub

Option Explicit
Private Curlayer As AcadLayer
Private bActive As Boolean
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
    If bActive Then
        ThisDrawing.ActiveLayer = Curlayer
    End If
    
    If CommandName = "LINE" Then
        Set Curlayer = ThisDrawing.ActiveLayer
        ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
        bActive = True
    End If
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
    If CommandName = "LINE" Then
        bActive = False
        ThisDrawing.ActiveLayer = Curlayer
    End If
End Sub