[求助]：关于剖面线的

流浪狗狗

剖面线在VBA中是怎样实现的啊？
我有人能给我一个画剖面线的范例吗？
谢谢！！

雪山飞狐(lzh)

帮助里有的，你没有帮助么？

linxue5688

好的，我自己编的，给你参考参考！
Sub poumianxian()
   Dim a As Double
   Dim b As Double
   Dim r As Double

   Dim p0  As Variant
   
   Dim p1(0 To 2) As Double
   Dim p2(0 To 2) As Double
   Dim p3(0 To 2) As Double
   Dim center(0 To 2) As Double
   Dim m As AcadModelSpace
   Dim outerloop(0 To 3) As AcadEntity
   Dim lineObject(0 To 3) As AcadLine
   Dim innerloop(0) As AcadEntity
   Dim circleObject As AcadCircle
   Dim hatchObject As AcadHatch
   
   a = ThisDrawing.Utility.GetReal("输入宽度：")
   b = ThisDrawing.Utility.GetReal("输入高度：")
   r = ThisDrawing.Utility.GetReal("输入内圆半径：")
   
     
   p0 = ThisDrawing.Utility.GetPoint(, "输入图形插入点：")
   
      
   center(0) = p0(0) + a / 2#
   center(1) = p0(1) + b / 2#
   center(2) = p0(2)
   
   p1(0) = p0(0) + a
   p1(1) = p0(1)
   p1(2) = p0(2)
   
   p2(0) = p1(0)
   p2(1) = p1(1) + b
   p2(2) = p1(2)
   
   p3(0) = p2(0) - a
   p3(1) = p2(1)
   p3(2) = p2(2)
   
   Set m = ThisDrawing.ModelSpace
   
   Set lineObject(0) = m.AddLine(p0, p1)
   Set lineObject(1) = m.AddLine(p1, p2)
   Set lineObject(2) = m.AddLine(p2, p3)
   Set lineObject(3) = m.AddLine(p3, p0)
   
   Set circleObject = m.AddCircle(center, r)
   
      
   '画剖面线
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim assocVar As Boolean
   
    '定义剖面线的模式
    patternName = "ANSI31"
    PatternType = 0
    '设定剖面线与外轮廓线相关联
    assocVar = True
   
    '在模型空间创建剖面线对象
    Set hatchObject = m.AddHatch(PatternType, patternName, assocVar)
   
    hatchObject.PatternScale = 3
   
    '创建内外轮廓线
   
    Dim i As Integer
    For i = 0 To 3
        Set outerloop(i) = lineObject(i)
    Next
      Set innerloop(0) = circleObject
    hatchObject.AppendOuterLoop (outerloop)
    hatchObject.AppendInnerLoop (innerloop)
    hatchObject.Evaluate
    ThisDrawing.Regen True
   
End Sub