|
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