[讨论]：像这样的图形如何画剖面线

jasonwangb

'创建剖面线

    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim assocVar As Boolean
   
    '定义剖面线的模式
    patternName = "ANSI31"
    PatternType = 0
    '设定剖面线与外轮廓线相关联
    assocVar = True
   
   
    '在模型空间创建剖面线对象
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch _
                   (PatternType, patternName, assocVar)



'定义螺纹断面直线对象
        Dim ObjLine801, ObjLine802, ObjLine803 As AcadLine
        Dim ObjLine804, ObjLine805 As AcadLine
        Dim arcobj01, arcobj02, arcobj03 As AcadArc

'定义螺纹断面数组变量，作为各顶点的坐标
        Dim st801(2) As Double
        Dim st802(2) As Double
        Dim st803(2) As Double
        Dim st804(2) As Double
        Dim st805(2) As Double
        Dim st806(2) As Double
        Dim st807(2) As Double
        Dim stCen01(2) As Double
        Dim stCen02(2) As Double
        Dim stCen03(2) As Double
        Dim ststart(2) As Double

       。。。。。。。。


       Dim outerLoop(0 To 7) As AcadEntity
'连接对应的顶点,得到螺纹断面图形
        Set outerLoop(0) = ThisDrawing.ModelSpace.AddLine(ststart, st801)
        Set outerLoop(1) = ThisDrawing.ModelSpace.AddArc(stCen01, r1, 3 * PI / 2, 2 * PI)
        Set outerLoop(2) = ThisDrawing.ModelSpace.AddLine(st802, st803)
        Set outerLoop(3) = ThisDrawing.ModelSpace.AddLine(st803, st804)
        Set outerLoop(4) = ThisDrawing.ModelSpace.AddLine(st804, st805)
        Set outerLoop(5) = ThisDrawing.ModelSpace.AddArc(stCen02, r2, PI, 3 * PI / 2)
        Set outerLoop(6) = ThisDrawing.ModelSpace.AddLine(st806, st807)
        Set outerLoop(7) = ThisDrawing.ModelSpace.AddArc(stCen03, r3, 5 * PI / 4, 7 * PI / 4)

     hatchObj.AppendOuterLoop (outerLoop)
      
    hatchObj.Evaluate
    ThisDrawing.Regen True

                               
登录/注册后可看大图