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

Option Explicit
Dim CurUCS As AcadUCS
Dim CurLayer As AcadLayer
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
Set CurUCS = ThisDrawing.ActiveUCS
Set CurLayer = ThisDrawing.ActiveLayer
SendKeys "{Esc}"
ThisDrawing.SendCommand "ucs" & vbCr & "world" & vbCr
ThisDrawing.Layers("0").Freeze = False
ThisDrawing.Layers("0").LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers("0")
End If
End Sub
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CommandName = "XREF" Or CommandName = "XATTACH" Then
ThisDrawing.ActiveUCS = CurUCS
ThisDrawing.ActiveLayer = CurLayer
End If
End Sub

Sub owcs()
    Dim zero(2) As Double
    Dim Xaxis(2) As Double
    Dim Yaxis(2) As Double
    Dim strNm As String, sUcs As String
    Dim oUcs As AcadUCS
   
    If ThisDrawing.GetVariable("WORLDUCS") = 1 Then
        Exit Sub
    Else
        sUcs = ThisDrawing.GetVariable("UCSNAME")
        'Debug.Print sUcs
        Xaxis(0) = 1: Yaxis(1) = 1
        Set oUcs = ThisDrawing.UserCoordinateSystems.Add(zero, Xaxis, Yaxis, "World")
        ThisDrawing.ActiveUCS = oUcs
    End If
End Sub