Sub Example_SetWidth()
    'Следующий код запрашивает Вас выбирать легкую ломаную линию и
    'затем запрашивает Вас относительно установки ширины каждой доли ломаной линии. 
    'Нажатие ENTER не определяя ширину эквивалентно вводу 0. 
	  
    Dim returnObj As AcadObject
    Dim basePnt As Variant
    Dim retCoord As Variant
    Dim StartWidth As Double
    Dim EndWidth As Double
    Dim i, j As Long
    Dim nbr_of_segments As Long
    Dim nbr_of_vertices As Long
    Dim segment As Long
    Dim promptStart As String
    Dim promptEnd As String
              
    On Error Resume Next
   
    ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select a polyline"
       
    'Удостоверьтесь, что пользователь выбрал ломаную линию.
    If Err <> 0 Then
        If returnObj.EntityName <> "AcDbPolyline" Then
            MsgBox "Вы не выбирали ломаную линию"
        End If
        Exit Sub
    End If
    
    'Получите координаты каждой вершины отобранной ломаной линии.
    'Координаты возвращены в массиве точек.
    retCoord = returnObj.Coordinates
    
    segment = 0
    i = LBound(retCoord)                 ' Индекс начала массива координат
    j = UBound(retCoord)                 ' Индекс конца массива координат
    nbr_of_vertices = ((j - i) \ 2) + 1  ' Номер вершины в ломаной линии
    
    'Определите число долей в ломаной линии.
    'Закрытая ломаная линия имеет столько же долей, сколько вершин.
    'Открытая ломаная линия имеет на одину долю меньше, чем вершин.
    'Проверьте свойство Closed, чтобы определить, закрыта ли ломаная линия.
    
    If returnObj.Closed Then
        nbr_of_segments = nbr_of_vertices
    Else
        nbr_of_segments = nbr_of_vertices - 1
    End If
    
    'Спросите пользователя относительно ширины для каждой доли
    Do While nbr_of_segments > 0
          
        'Получите значения ширины от пользователя
        promptStart = vbCrLf & "Определите ширину в начале доли в " & retCoord(i) & "," & retCoord(i + 1) & " ==> "
        promptEnd = vbCrLf & "Теперь определите ширину в конце той доли ==> "
       
        StartWidth = ThisDrawing.Utility.GetReal(promptStart)
        EndWidth = ThisDrawing.Utility.GetReal(promptEnd)

        'Установите ширину текущей доли
        returnObj.SetWidth segment, StartWidth, EndWidth
     
        'Подготовитесь получать ширину следующей доли
        i = i + 2
        segment = segment + 1
        nbr_of_segments = nbr_of_segments - 1
    Loop
      
    MsgBox "Размеры доли были установлены", , "SetWidth Пример"

End Sub