HatchStyle Пример

Sub Example_HatchStyle()
    ' Этот пример создает ассоциативную штриховку в пространстве модели.
    ' Стиль штриховки изменяется, чтобы демонстрировать различные пути, которыми обработаны внутренние контуры.
    
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    
    ' Определите штриховку
    patternName = "ANSI31"
    PatternType = 0
    bAssociativity = True
    
    ' Создайте ассоциативный объект Hatch
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
    
    ' Создайте внешний контур для штриховки.
    ' Дуга и линия используются, чтобы создать замкнутый контур.
    
    Dim outerLoop(0 To 1) As AcadEntity
    Dim center(0 To 2) As Double
    Dim radius As Double
    Dim startAngle As Double
    Dim endAngle As Double
    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)
    
    ' Добавьте в конец первый круг как один внутренний контур
    Dim innerLoop1(0) As AcadEntity
    center(0) = 5: center(1) = 4.5: center(2) = 0
    radius = 1
    Set innerLoop1(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
    hatchObj.AppendInnerLoop (innerLoop1)
    
    ' Добавьте в конец второй круг как другой внутренний контур
    Dim innerLoop2(0) As AcadEntity
    radius = 0.5
    Set innerLoop2(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
    hatchObj.AppendInnerLoop (innerLoop2)
    
    ' Установите стиль штриховки на нормаль
    hatchObj.hatchstyle = acHatchStyleNormal
    hatchObj.Evaluate
    ThisDrawing.Regen True
    MsgBox "HatchStyle установлен в " & Choose(hatchObj.hatchstyle + 1, "acHatchStyleNormal", "acHatchStyleOuter", "acHatchStyleIgnore"), , "HatchStyle Пример"
    
    ' Установите стиль штриховки во внешний
    hatchObj.hatchstyle = acHatchStyleOuter
    hatchObj.Evaluate
    ThisDrawing.Regen True
    MsgBox "HatchStyle установлен в " & Choose(hatchObj.hatchstyle + 1, "acHatchStyleNormal", "acHatchStyleOuter", "acHatchStyleIgnore"), , "HatchStyle Пример"
        
    ' Установите стиль штриховки игнорировать
    hatchObj.hatchstyle = acHatchStyleIgnore
    hatchObj.Evaluate
    ThisDrawing.Regen True
    MsgBox "HatchStyle установлен в " & Choose(hatchObj.hatchstyle + 1, "acHatchStyleNormal", "acHatchStyleOuter", "acHatchStyleIgnore"), , "HatchStyle Пример"
               
End Sub
Сайт управляется системой uCoz