如何实现填充图案

xianglongg

请教版主和各位高手

我刚开始学vba在cad中编程

可以告诉我

如何实现填充图案

谢谢了

xianglongg

我找到答案了

大家一起分享

Sub Example_HatchStyle()
      ' 这个范例在模型空间中建立一个关联式图案填充
      ' 接着改变图案填充样式来示范各种
      ' 内回路的处理方式。

      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)
          hatchObj.Update
      ' 建立图案填充的外回路
      ' 使用一个弧以及一条线来建立封闭回路

      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) = 50: center(1) = 30: center(2) = 0
      radius = 30
      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) = 50: center(1) = 34.5: center(2) = 0
      radius = 10
      Set innerLoop1(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
      hatchObj.AppendInnerLoop (innerLoop1)
      ' 将图案填充样式设定忽略
      hatchObj.HatchStyle = acHatchStyleIgnore
      ThisDrawing.Regen True
     

  End Sub