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
Сайт управляется системой uCoz