Surfer13自动绘图之制作责任表

责任表，在工程制图中必不可少，下面将介绍如何使用Surfer绘制标准的责任表。责任表的距离见下图（单位mm）:

实现代码如下：

        '制作责任表
        Dim XOffset, YOffset As Double                           '责任表偏移距
        Dim XBasePosRspTalbe, YBasePosRspTalbe As Double         '责任表绘图基点

        Dim SurferApp As Object            ‘启动Surfer对象
        Dim Doc As Object                       ‘文档对象
        Dim Plotwindow As Object            ‘绘图对象
        Dim ShapesResponsibilityTable As Object       ‘责任表对象


        SurferApp = CreateObject("Surfer.Application")                                ‘启动Surfer
        SurferApp.Visible = True                                                                   ‘Surfer可见
        SurferApp.PageUnits = Surfer.SrfPageUnits.srfUnitsCentimeter           '将surfer绘图单位改成公制cm

        Doc = SurferApp.Documents.Add(Surfer.SrfDocTypes.srfDocPlot)           
        Plotwindow = Doc.Windows(1)

        ShapesResponsibilityTable = Doc.Shapes                                       ‘责任表为Surfer的shape对象

        Dim PolyLineArray(3) As Double                                                      ‘定义多段线数组                                   
        Dim Polyline(12) As Object
        Dim TextResponsibilityTable(9) As Object   
        Dim StrTextResponsibilityTable() As String = New String(9) {" 拟  编 ", " 审  核 ", "项目负责", "总工程师", " 院  长 ", _
                                                                    " 图  号 ", " 顺序号 ", " 比例尺 ", " 日  期 ", "资料来源"}
        Dim XBasePos, YBasePos As Double
        XOffset = 5
        YOffset = 25
        XBasePosRspTalbe = XBasePos + XOffset                  ‘确定X坐标的位置
        YBasePosRspTalbe = YBasePos + YOffset                   ‘确定Y坐标的位置

        '画线
        '-----------------------------------------------------------------------------
        '横向第一条线
        PolyLineArray(0) = XBasePosRspTalbe
        PolyLineArray(1) = YBasePosRspTalbe
        PolyLineArray(2) = PolyLineArray(0) + 9
        PolyLineArray(3) = PolyLineArray(1)
        Polyline(0) = ShapesResponsibilityTable.AddPolyLine(PolyLineArray)  '绘出多段线
        '横向第二条线
        PolyLineArray(0) = XBasePosRspTalbe
        PolyLineArray(1) = YBasePosRspTalbe - 0.7
        PolyLineArray(2) = PolyLineArray(0) + 9
        PolyLineArray(3) = PolyLineArray(1)
        Polyline(1) = ShapesResponsibilityTable.AddPolyLine(PolyLineArray)  '绘出多段线
        '横向第三条线至8条线
        For i As Integer = 0 To 5
            PolyLineArray(0) = XBasePosRspTalbe
            PolyLineArray(1) = YBasePosRspTalbe - 1.5 - i * 0.7
            PolyLineArray(2) = PolyLineArray(0) + 9
            PolyLineArray(3) = PolyLineArray(1)
            Polyline(i + 2) = ShapesResponsibilityTable.AddPolyLine(PolyLineArray)  '绘出多段线
        Next i
        '纵向第一条线
        PolyLineArray(0) = XBasePosRspTalbe
        PolyLineArray(1) = YBasePosRspTalbe
        PolyLineArray(2) = PolyLineArray(0)
        PolyLineArray(3) = PolyLineArray(1) - 5
        Polyline(8) = ShapesResponsibilityTable.AddPolyLine(PolyLineArray)  '绘出多段线
        '纵向第二条线
        PolyLineArray(0) = XBasePosRspTalbe + 2
        PolyLineArray(1) = YBasePosRspTalbe - 1.5
        PolyLineArray(2) = PolyLineArray(0)
        PolyLineArray(3) = PolyLineArray(1) - 3.5
        Polyline(9) = Doc.Shapes.AddPolyLine(PolyLineArray)  '绘出多段线
        '纵向第三条线
        PolyLineArray(0) = XBasePosRspTalbe + 4.5
        PolyLineArray(1) = YBasePosRspTalbe - 1.5
        PolyLineArray(2) = PolyLineArray(0)
        PolyLineArray(3) = PolyLineArray(1) - 3.5
        Polyline(10) = ShapesResponsibilityTable.AddPolyLine(PolyLineArray)  '绘出多段线
        '纵向第四条线
        PolyLineArray(0) = XBasePosRspTalbe + 6.5
        PolyLineArray(1) = YBasePosRspTalbe - 1.5
        PolyLineArray(2) = PolyLineArray(0)
        PolyLineArray(3) = PolyLineArray(1) - 3.5
        Polyline(11) = ShapesResponsibilityTable.AddPolyLine(PolyLineArray)  '绘出多段线
        '纵向第五条线
        PolyLineArray(0) = XBasePosRspTalbe + 9
        PolyLineArray(1) = YBasePosRspTalbe
        PolyLineArray(2) = PolyLineArray(0)
        PolyLineArray(3) = PolyLineArray(1) - 5
        Polyline(12) = ShapesResponsibilityTable.AddPolyLine(PolyLineArray)  '绘出多段线

        '设置线型：
        For i As Integer = 0 To 12
            Polyline(i).Line.Style = "Solid"
            Polyline(i).Line.Width = 0.05
        Next i
        '-----------------------------------------------------------------------------
        '写入固定文字
        Dim xTmp, yTmp As Integer

        For i As Integer = 0 To 9
            xTmp = Int(i / 5)
            yTmp = i Mod 5
            TextResponsibilityTable(i) = ShapesResponsibilityTable.AddText(X:=XBasePosRspTalbe + xTmp * 4.5 + 0.15, _
                                                        Y:=YBasePosRspTalbe - 1.5 - yTmp * 0.7 - 0.15, _
                                                     Text:=StrTextResponsibilityTable(i))


            TextResponsibilityTable(i).Font.Size = 12                    '修改字体大小
            TextResponsibilityTable(i).Font.Bold = True                  '修改字体粗细
            TextResponsibilityTable(i).Font.Face = "宋体"                '字体改为宋体
            TextResponsibilityTable(i).name = StrTextResponsibilityTable(i)
        Next i

’绘制结果：

怎么样，是不是很好呢