Sub Example_ActiveUCS()
    ' Этот пример возвращает текущие настройки UCS и затем устанавливает новий UCS.
    ' Наконец, он возвращает UCS к предыдущей установке.
    
    Dim newUCS As AcadUCS
    Dim currUCS As AcadUCS
    Dim origin(0 To 2) As Double
    Dim xAxis(0 To 2) As Double
    Dim yAxis(0 To 2) As Double
    
    ' Получите текущий сохранённый UCS активного документа. Если текущий UCS не сохранен,
    ' то добавляется новый UCS к коллекции UserCoordinateSystems
    If ThisDrawing.GetVariable("UCSNAME") = "" Then
        ' Так как текущий UCS не сохранен, получаем данные и сохраняем их
        With ThisDrawing
            Set currUCS = .UserCoordinateSystems.Add( _
                            .GetVariable("UCSORG"), _
                            .Utility.TranslateCoordinates(.GetVariable("UCSXDIR"), acUCS, acWorld, 0), _
                            .Utility.TranslateCoordinates(.GetVariable("UCSYDIR"), acUCS, acWorld, 0), _
                            "OriginalUCS")
        End With
    Else
        Set currUCS = ThisDrawing.ActiveUCS  'текущий UCS сохранен
    End If
    
    MsgBox "Текущий UCS " & currUCS.name, vbInformation, "ActiveUCS Пример"
    
    ' Создайте UCS и сделайте его текущим
    origin(0) = 0: origin(1) = 0: origin(2) = 0
    xAxis(0) = 1: xAxis(1) = 1: xAxis(2) = 0
    yAxis(0) = -1: yAxis(1) = 1: yAxis(2) = 0
    Set newUCS = ThisDrawing.UserCoordinateSystems.Add(origin, xAxis, yAxis, "TestUCS")
    ThisDrawing.ActiveUCS = newUCS
    MsgBox "Текущий UCS " & newUCS.name, vbInformation, "ActiveUCS Пример"
    
    ' Сбросьте UCS к его предыдущей установке
    ThisDrawing.ActiveUCS = currUCS
    MsgBox "UCS сброшен к " & currUCS.name, vbInformation, "ActiveUCS Пример"
End Sub