|
Elevation Пример |
Sub Example_Elevation()
' Этот пример создает ассоциативную штриховку в пространстве модели.
' Уровень для штриховки изменен.
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 arcObj As AcadArc
Dim lineObj As AcadLine
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 arcObj = ThisDrawing.ModelSpace.AddArc(center, radius, startAngle, endAngle)
Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.startPoint, arcObj.endPoint)
Set outerLoop(0) = arcObj
Set outerLoop(1) = lineObj
' Добавьте в конец внешний контур к объекту штриховки
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)
' Измените направление рассмотрения области просмотра, чтобы лучше видеть уровень
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll
' Найдите текущий уровень для штриховки
Dim currElevation As Double
currElevation = hatchObj.Elevation
MsgBox "Текущий уровень " & hatchObj.Elevation, , "Elevation Пример"
' Установите уровень штриховки на 3
hatchObj.Elevation = 3#
hatchObj.Evaluate
ZoomAll
MsgBox "Уровень - теперь " & hatchObj.Elevation, , "Elevation Пример"
End Sub