Sub Example_YVector()
    'Находит текущую установку YVector для данного UCS.
    'Затем изменяет YVector и сбрасывает UCS.

    Dim viewportObj As AcadViewport
    
    'Установите viewportObj переменную в активную область просмотра
    Set viewportObj = ThisDrawing.ActiveViewport
    
    'Определите новый UCS и включите значок UCS в точке начала.
    Dim ucsObj As AcadUCS
    Dim origin(0 To 2) As Double
    Dim xAxisPoint(0 To 2) As Double
    Dim yAxisPoint(0 To 2) As Double
    
    origin(0) = 2: origin(1) = 2: origin(2) = 0
    xAxisPoint(0) = 3: xAxisPoint(1) = 2: xAxisPoint(2) = 0
    yAxisPoint(0) = 2: yAxisPoint(1) = 3: yAxisPoint(2) = 0
    
    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPoint, yAxisPoint, "UCS1")
    ThisDrawing.ActiveUCS = ucsObj
    viewportObj.UCSIconOn = True
    viewportObj.UCSIconAtOrigin = True
    ThisDrawing.ActiveViewport = viewportObj
    
    'Покажите текущую установку векторов
    MsgBox "Текущий XVector: " _
            & ucsObj.XVector(0) & ", " & ucsObj.XVector(1) & ", " & ucsObj.XVector(2) & vbCrLf _
            & "Текущий YVector: " _
            & ucsObj.YVector(0) & ", " & ucsObj.YVector(1) & ", " & ucsObj.YVector(2), , "YVector Пример"

    'Измените установку YVector
    Dim newVector(0 To 2) As Double
    newVector(0) = -1: newVector(1) = -1: newVector(2) = 0
    ucsObj.YVector = newVector
    
    'Сбросьте активный UCS, чтобы видеть изменение
    ThisDrawing.ActiveUCS = ucsObj
    
    MsgBox "Новый XVector: " _
            & ucsObj.XVector(0) & ", " & ucsObj.XVector(1) & ", " & ucsObj.XVector(2) & vbCrLf _
            & "YVector: " _
            & ucsObj.YVector(0) & ", " & ucsObj.YVector(1) & ", " & ucsObj.YVector(2), , "YVector Пример"
    
End Sub