Sub Example_ISOPenWidth()
    'Этот пример создает ассоциативную штриховку в пространстве модели.
    'ISOPenWidth образца штриховки затем возвращен и изменен.
    
    Dim hatchObj As AcadHatch
    Dim patternName As String, PatternType As Long
    Dim bAssociativity As Boolean
    Dim outerLoop(0 To 1) As Object
    Dim center(0 To 2) As Double
    Dim radius As Double, startAngle As Double, endAngle As Double
    Dim innerLoop1(0) As Object, innerLoop2(0) As Object
    Dim PatternScale As Double

    'Определите штриховку
    patternName = "ANSI31": PatternType = 0: bAssociativity = True
    
    'Создайте ассоциативный объект Hatch
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
   
    'Создайте внешний контур для штриховки.
    'Дуга и линия используются, чтобы создать замкнутый контур.
    center(0) = 5: center(1) = 3: center(2) = 0
    radius = 3:  startAngle = 0:  endAngle = 3.141592
    
    Set outerLoop(0) = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
    Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine(outerLoop(0).startPoint, outerLoop(0).endPoint)
        
    'Приложите внешний контур к объекту штриховки
    hatchObj.AppendOuterLoop (outerLoop)
    
    'Приложите первый круг как один внутренний контур
    center(0) = 5: center(1) = 4.5: center(2) = 0
    radius = 1
    
    Set innerLoop1(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
    hatchObj.AppendInnerLoop (innerLoop1)
    
    'Приложите второй круг как другой внутренний контур
    radius = 0.5
    Set innerLoop2(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
    hatchObj.AppendInnerLoop (innerLoop2)
    
    'Оцените и покажите штриховку
    hatchObj.Evaluate
    ThisDrawing.Regen True
    
    'Найдите ширину пера ISO образца штриховки
    MsgBox "Ширина пера ISO образца штриховки: " & hatchObj.ISOPenWidth, vbInformation

    'Измените ширину пера ISO образца штриховки
    hatchObj.ISOPenWidth = acPenWidth050
    hatchObj.Evaluate
    ThisDrawing.Regen True
    
    'Покажите новую перьевую ширину для этой штриховки
    If hatchObj.ISOPenWidth = acPenWidthUnk Then
        'Нестандартные перьевые размеры
        MsgBox "Ширина пера ISO образца штриховки - теперь: " & hatchObj.PatternScale, vbInformation
    Else
        'Стандартные перьевые размеры
        MsgBox "Ширина пера ISO образца штриховки - теперь: " & hatchObj.ISOPenWidth, vbInformation
    End If

End Sub