ePnt(1) = 10 * cells(i + 1, 2).Value
    ePnt(2) = 0
    Set lineobj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnt)
    i = i + 1
    Loop
4.3  桩号及高程的写入
4.3.1  定义文字的插入位置  以桩号里程为x坐标，0为y坐标，0为z坐标，确定文字的插入点。
4.3.2  以单行文字形式创建桩号及高程文字，定义文字的格式、字体、高度、倾斜角度。插入后的文字应逆时针旋转90度。
4.4  辅助网格线的绘制
4.4.1  辅助网格线能较为直观地表示桩号及地面高程的对应关系，有助于纵坡设计；
4.4.2  以桩号里程为x坐标，0为y坐标，0为z坐标，确定网格线第一点；以桩号里程为x坐标，10倍所对应的地面高程为y坐标，0为z坐标，确定网格线第二点；两点连线，则为网格线。
5  实例
5.1  运行AutoCAD2000程序；
5.2  打开AutoCAD的VBA编辑器（命令：VBAIDE）；
5.3  创建成下面的过程及代码，并运行之：
 
Sub ZDM()
   
    Dim Excel As Excel.Application
    Dim ExcelSheet As Object
    Dim ExcelWorkbook As Object
    Dim i As Integer
    Dim lineobj As AcadLine
    Dim klineobj As AcadLine
    Dim sPnt(0 To 2) As Double
    Dim ePnt(0 To 2) As Double
    Dim kPnt(0 To 2) As Double
    Dim hPnt(0 To 2) As Double
    Dim ksPnt(0 To 2) As Double
    Dim kePnt(0 To 2) As Double
    Dim dmPnt(0 To 2) As Double
    Dim textObj As AcadText
    Dim txtStr As String
    Dim insPnt As Variant
    Dim txtHeight As Double
    Dim layObj As AcadLayer
    Dim newLayer As AcadLayer
    Set layObj = ThisDrawing.Layers.Add("标注")
    Set layObj = ThisDrawing.Layers.Add("地面线")
    Set layObj = ThisDrawing.Layers.Add("网格线")
    Dim atTxtobj As AcadTextStyle
    Set atTxtobj = ThisDrawing.ActiveTextStyle
    atTxtobj.fontFile = "c:\windows\fonts\simfang.ttf"
   
'创建Excel应用程序
    On Error Resume Next
    Set Excel = GetObject(, "Excel.Application")
    If Err <> 0 Then
     Set Excel = CreateObject("Excel.Application")
    End If
    '打开Excel表
    ExcelName = InputBox("路径：")
    Excel.Workbooks.Open ExcelName
   
    '表格不可见
    Excel.Visible = False
   
    '读入坐标点画地面线
    Worksheets("sheet1").Activate
    i = 3
    Do Until cells(i, 1).Value = ""
    If cells(i + 1, 1) = 0 Then
    Exit Do
    End If
    sPnt(0) = cells(i, 1).Value
    sPnt(1) = 10 * cells(i, 2).Value
    sPnt(2) = 0
    ePnt(0) = cells(i + 1, 1).Value
    ePnt(1) = 10 * cells(i + 1, 2).Value
    ePnt(2) = 0
    Set newLayer = ThisDrawing.Layers("地面线")
    ThisDrawing.ActiveLayer = newLayer
    newLayer.Color = acWhite
    Set lineobj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnt)
    If cells(i, 2) = "" Then lineobj.Delete
    i = i + 1
    Loop
   
'画辅助网格线及插入数据
    i = 3
    Do Until cells(i, 1).Value = ""
  '画辅助网格线
    ksPnt(0) = cells(i, 1).Value: ksPnt(1) = 0: ksPnt(2) = 0
    kePnt(0) = cells(i, 1).Value: kePnt(1) = 10 * cells(i, 2).Value: kePnt(2) = 0
    dmPnt(0) = cells(i, 1).Value: dmPnt(1) = 48: dmPnt(2) = 0
    Set newLayer = ThisDrawing.Layers("网格线")
    ThisDrawing.ActiveLayer = newLayer
    newLayer.Color = acGreen
    Set klineobj = ThisDrawing.ModelSpace.AddLine(ksPnt, kePnt)
   '插入桩号
    Set newLayer = ThisDrawing.Layers("标注")
    ThisDrawing.ActiveLayer = newLayer
    newLayer.Color = acCyan
    a = cells(i, 1).Value