Sub Example_TranslateCoordinates()
    'Этот пример создает UCS с точкой начала в 2, 2, 2.
    'Затем, точка введена пользователем. Координаты WCS и UCS этой точки выводятся в Msgbox.
    
    'Создайте "New_UCS" в текущем рисунке
    Dim ucsObj As AcadUCS
    Dim origin(0 To 2) As Double
    Dim xAxisPnt(0 To 2) As Double
    Dim yAxisPnt(0 To 2) As Double
    
    'Определите UCS
    origin(0) = 2#: origin(1) = 2#: origin(2) = 2#
    xAxisPnt(0) = 5#: xAxisPnt(1) = 2#: xAxisPnt(2) = 2#
    yAxisPnt(0) = 2#: yAxisPnt(1) = 6#: yAxisPnt(2) = 2#
    
    'Добавьте UCS к коллекции UserCoordinatesSystems
    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
    ThisDrawing.ActiveUCS = ucsObj
    
    'Получите активную область просмотра и удостоверьтесь, что значок UCS есть
    Dim viewportObj As AcadViewport
    Set viewportObj = ThisDrawing.ActiveViewport
    viewportObj.UCSIconOn = True
    viewportObj.UCSIconAtOrigin = True
    ThisDrawing.ActiveViewport = viewportObj
   
    'Сделайте так, чтобы пользователь ввел точку
    Dim pointWCS As Variant
    pointWCS = ThisDrawing.Utility.GetPoint(, "Введите точку:")
    
    'Переведите точку в координаты UCS
    Dim pointUCS As Variant
    pointUCS = ThisDrawing.Utility.TranslateCoordinates(pointWCS, acWorld, acUCS, False)
    
    'Покажите координаты точки
    MsgBox "Точка имеет следующие координаты:" & vbCrLf & _
            "WCS: " & pointWCS(0) & ", " & pointWCS(1) & ", " & pointWCS(2) & vbCrLf & _
            "UCS: " & pointUCS(0) & ", " & pointUCS(1) & ", " & pointUCS(2), , "TranslateCoordinates Пример"

End Sub