GetLoopAt Пример |
Sub Example_GetLoopAt() ' Этот пример создает ассоциативную штриховку в пространстве модели. ' Затем находит объекты, которые составляют первый контур штриховки. 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.Evaluate ThisDrawing.Regen True ' Найдите объекты, которые составляют первый контур Dim loopObjs As Variant hatchObj.GetLoopAt 0, loopObjs ' Найдите типы объектов в контуре Dim I As Integer Dim objName As String objName = "" For I = LBound(loopObjs) To UBound(loopObjs) objName = objName & loopObjs(I).EntityName & ", " Next MsgBox "Объекты в первом контуре штриховки: " & objName, , "GetLoopAt Пример" End Sub