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