|
PatternDouble Пример |
Sub Example_PatternDouble()
'Этот пример создает ассоциативную штриховку в пространстве модели.
'Затем возвращает, действительно ли образец удвоен и затем изменяет это значение.
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
'Определите штриховку
patternName = "ansi31"
PatternType = acHatchPatternTypePreDefined
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.Evaluate
ThisDrawing.Regen True
'Определите, удвоен ли образец
Dim patternDouble As Boolean
patternDouble = hatchObj.patternDouble
MsgBox "Удвоение образца: " & hatchObj.patternDouble, , "PatternDouble Пример"
'Измените угол образца штриховки
hatchObj.patternDouble = Not (hatchObj.patternDouble)
hatchObj.Evaluate
ThisDrawing.Regen True
MsgBox "Удвоение образца: " & hatchObj.patternDouble, , "PatternDouble Пример"
End Sub