练手示例：给每个直线顶点加序号

Function CreatSelectionSet(InputEntityObjectName As Variant, Pt1 As Variant, Pt2 As Variant) As AcadSelectionSet
   
   On Error Resume Next
   Dim SSet As AcadSelectionSet
   If Not IsNull(ThisDrawing.SelectionSets.Item("SelectEntity")) Then
     Set CreatSelectionSet = ThisDrawing.SelectionSets.Item("SelectEntity")
     CreatSelectionSet.Delete
   End If
   Set CreatSelectionSet = ThisDrawing.SelectionSets.Add("SelectEntity")
   'Pt1 = ThisDrawing.Utility.GetPoint(, "Input First Point")
   'Pt2 = ThisDrawing.Utility.GetPoint(Pt1, "Input First Point")
   
   Dim gpCode(0) As Integer
   Dim dataValue(0) As Variant
   'ReDim dataValue(UBound(InputEntityObjectName)) As Variant
   gpCode(0) = 0
   
   For ii = 0 To UBound(InputEntityObjectName)
     dataValue(ii) = InputEntityObjectName(ii)
   Next ii
   CreatSelectionSet.Select acSelectionSetWindow, Pt1, Pt2, gpCode, dataValue
End Function
Sub ReadTable()
   Dim Pt1(0 To 2) As Double, Pt2(0 To 2) As Double
   Dim SSet As AcadSelectionSet
   Dim InputEntityObjectName As Variant
   Pt1(0) = 2850: Pt1(1) = 2660: Pt1(2) = 0
   Pt2(0) = -10: Pt2(1) = -10: Pt2(2) = 0
   InputEntityObjectName = Array("Line", "Text", "Dimension")
   
   Set SSet = CreatSelectionSet(InputEntityObjectName, Pt1, Pt2)
   Debug.Print SSet.Count
   Dim Ent As AcadEntity, DrawingText As AcadText
   Dim DrawingLine As AcadLine, DrawingCircle As AcadCircle
   ii = 1
    Dim alignmentPoint(0 To 2) As Double
    alignmentPoint(0) = 5: alignmentPoint(1) = 3: alignmentPoint(2) = 0
   
   For Each DrawingLine In SSet
      With ThisDrawing.ModelSpace
        Set DrawingCircle = .AddCircle(DrawingLine.EndPoint, 35)
        Set DrawingText = .AddText(ii, alignmentPoint, 30)
        With DrawingText
          '.HorizontalAlignment = acHorizontalAlignmentFit
          .Alignment = acAlignmentMiddleCenter
          .TextAlignmentPoint = DrawingLine.EndPoint
          
        End With
      End With
      ii = ii + 1
   Next
End Sub

Sub ll()
  Dim LineData As AcadLine, ArcData As AcadArc
  Dim DrawingText As AcadText, DrawingCircle As AcadCircle
  Close #1
  Open "D:\ls.txt" For Output As #1
  
  Write #1, "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10", "m11", "m12"
  
  Dim Ent As AcadEntity
  ii = 1
  For Each Ent In ThisDrawing.ModelSpace
            
    
    m1 = Ent.ObjectName
    m2 = Ent.ObjectID
    Select Case Ent.ObjectName
      Case "AcDbLine"
        Set LineData = Ent
        
        With LineData
          Set DrawingCircle = ThisDrawing.ModelSpace.AddCircle(.StartPoint, 35)
          
          Set DrawingText = ThisDrawing.ModelSpace.AddText(ii, .EndPoint, 30)
          With DrawingText
            .Alignment = acAlignmentMiddleCenter
            .TextAlignmentPoint = LineData.StartPoint
            ii = ii + 1
          End With
          
          m3 = Round(.StartPoint(0), 5)
          m4 = Round(.StartPoint(1), 5)
          m5 = Round(.StartPoint(2), 5)
          m6 = Round(.EndPoint(0), 5)
          m7 = Round(.EndPoint(1), 5)
          m8 = Round(.EndPoint(2), 5)
          
        End With
    End Select
    Write #1, m1, m2, m3, m4, m6, m7, m8
    
  Next Ent
  
  Close #1
End Sub

Sub ll()
   ThisDrawing.ActiveTextStyle.fontFile = "c:\windows\fonts\SIMHEI.TTF"
   Dim xlsSheet As Worksheet
   Set xlsSheet = ReturnXlsSheet(1)
   xlsSheet.Range("a:z").ClearContents
   
  
   Dim LineData As AcadLine, ArcData As AcadArc
   Dim DrawingText As AcadText, DrawingCircle As AcadCircle
   Close #1
   Open "D:\ls.txt" For Output As #1
   
   Write #1, "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10", "m11", "m12"
   
   Dim Ent As AcadEntity
   'Debug.Print ThisDrawing.ModelSpace.Count
   For ii = 1 To ThisDrawing.ModelSpace.Count
     'm1 = Ent.ObjectName
     Set Ent = ThisDrawing.ModelSpace.Item(ii - 1)
     Debug.Print ii, Ent.ObjectName, Ent.Handle
     m2 = Ent.ObjectID
     Select Case Ent.ObjectName
       Case "AcDbLine"
         Set LineData = Ent
         With LineData
           'Set DrawingCircle = ThisDrawing.ModelSpace.AddCircle(.StartPoint, 35)
           m1 = "第" & ii & "点"
     If ii = 1 Then
           m3 = Round(.StartPoint(0), 2)
           m4 = Round(.StartPoint(1), 2)
     Else
       m3 = "=c" & ii - 1 & "+ i" & ii - 1
       m4 = "=d" & ii - 1 & "+ j" & ii - 1
     End If
           m5 = Round(.StartPoint(2), 2)
           'm6 = Round(.EndPoint(0), 2)
    If ii = ThisDrawing.ModelSpace.Count Then
           m6 = "=c1"
           m7 = "=d1"
   Else
           m6 = "=c" & ii & "+ i" & ii
           'm7 = Round(.EndPoint(1), 2)
           m7 = "=d" & ii & "+ j" & ii
   
   End If
           m8 = Round(.EndPoint(2), 2)
           m9 = .Delta(0)
           m10 = .Delta(1)
           m11 = .Delta(2)
           ttt = "第" & ii & "点 " & "(" & m3 & "," & m4 & ")"
           
           'Set DrawingText = ThisDrawing.ModelSpace.AddText(ttt, .EndPoint, 10)
           With DrawingText
            ' .Alignment = acAlignmentMiddleCenter
            ' .TextAlignmentPoint = LineData.StartPoint
             
             'ii = ii + 1
           End With
           
         End With
     End Select
     Write #1, m1, m2, m3, m4, m5, m6, m7, m8, m9, m10, m11 ', m12
     
     With xlsSheet
       .Cells(ii, 1) = m1
       .Cells(ii, 2) = m2
       .Cells(ii, 3) = m3
       .Cells(ii, 4) = m4
       .Cells(ii, 5) = m5
       .Cells(ii, 6) = m6
       .Cells(ii, 7) = m7
       .Cells(ii, 8) = m8
       .Cells(ii, 9) = m9
       .Cells(ii, 10) = m10
       .Cells(ii, 11) = m11
     End With
   Next ii
   
   Close #1
End SubFunction ReturnXlsSheet(InputSheetNum As Integer) As Worksheet
     Dim xlApp As Object     ' This Line ,Not set Excel , run Excel
     ' 发生错误时跳到下一个语句继续执行
     On Error Resume Next
     ' 连接Excel应用程序
     Set xlApp = GetObject(, "Excel.Application")
     
     If Err.Number  0 Then
         Set xlApp = CreateObject("Excel.Application")
         xlApp.Visible = True
         xlApp.Workbooks.Add
     End If
     ' 返回当前活动的工作表
     Set ReturnXlsSheet = xlApp.Sheets(InputSheetNum)
End Function
Sub gggg()
   Dim xlsSheet As Worksheet
   Set xlsSheet = ReturnXlsSheet(1)
   Dim pp(0 To 2) As Double, ppp(0 To 2) As Double
   Dim ll As AcadLine
   For ii = 1 To 8
     For jj = 0 To 2
       pp(jj) = xlsSheet.Cells(ii, jj + 3)
       ppp(jj) = xlsSheet.Cells(ii, jj + 6)
     Next jj
     Set ll = ThisDrawing.ModelSpace.AddLine(pp, ppp)
     ll.color = ii
   Next ii
   
End Sub
Sub ls()
   Dim xlsSheet As Worksheet
   Set xlsSheet = ReturnXlsSheet(1)
   xlsSheet.Range("a:z").ClearContents
  
  Dim EntCount As Integer
  Dim Ent As AcadEntity, lineObj As AcadLine
  EntCount = ThisDrawing.ModelSpace.Count
  Dim mm() As Long
  Dim Num As Integer
  ReDim mm(EntCount - 2) As Long
  Dim BaseStartPoint As Variant, BaseEndPoint As Variant
  Num = 0
  For ii = 0 To EntCount - 1
    Set lineObj = ThisDrawing.ModelSpace(ii)
    With lineObj
      If .color = 200 Then
        baseentity = .ObjectID
        If .StartPoint(0)  mm(jj) Then
        mmm(Num) = mm(jj)
        Num = Num + 1
      End If
    Next jj
    Dim llss As Variant
    llss = InputPointData(BaseEndPoint, mmm)
    BaseEndPoint = llss(1)
        For jj = 0 To 2
          With xlsSheet
            .Cells(nn, jj + 1) = llss(0)(jj)
            .Cells(nn, jj + 1 + 3) = llss(1)(jj)
            .Cells(nn, 7) = "第" & nn - 1 & "点"
          End With
        Next jj
    
    nn = nn + 1
  Next ii
End Sub
Function InputPointData(InputPoint, InputArray) As Variant()
  Dim Ent As AcadEntity, lineObj As AcadLine
  Dim pp(1) As Variant, ppp(0 To 2) As Variant
  For ii = 0 To UBound(InputArray)
    Set lineObj = ThisDrawing.ObjectIdToObject(InputArray(ii))
    If InputPoint(0) = lineObj.EndPoint(0) _
       And InputPoint(1) = lineObj.EndPoint(1) _
       And InputPoint(2) = lineObj.EndPoint(2) Then
       
       pp(0) = lineObj.EndPoint
       pp(1) = lineObj.StartPoint
       
       InputPointData = pp
       Exit Function
    End If
    If InputPoint(0) = lineObj.StartPoint(0) _
      And InputPoint(1) = lineObj.StartPoint(1) _
      And InputPoint(2) = lineObj.StartPoint(2) Then
       
         pp(0) = lineObj.StartPoint
         pp(1) = lineObj.EndPoint
         InputPointData = pp
         Exit Function
    End If
  Next ii
End Function
Function InputEntityReturnType(InputChar As Long, InputArray As Variant)
  Dim Ent As AcadEntity, Ent1 As AcadEntity
  Dim pp()
  ReDim pp(UBound(InputArray) - 1)
  Dim BaseCount As Integer
  Set Ent = ThisDrawing.ObjectIdToObject(InputChar)
  BaseCount = 0
  For ii = 0 To UBound(InputArray)
    Set Ent1 = ThisDrawing.ObjectIdToObject(InputArray(ii))
    pp(BaseCount) = Ent.IntersectWith(Ent1, acExtendNone)
    BaseCount = BaseCount + 1
  Next ii
End Function
Sub DrawingCircle()
   Dim xlsSheet As Worksheet
   Set xlsSheet = ReturnXlsSheet(1)
   Dim pp(0 To 2) As Double, ppp(0 To 2) As Double
   Dim ll As AcadLine
   Dim DefineCircle As AcadCircle, TextObj As AcadText
   For ii = 2 To 6
     For jj = 0 To 2
       pp(jj) = xlsSheet.Cells(ii, jj + 1)
       ppp(jj) = xlsSheet.Cells(ii, jj + 4)
     Next jj
     Set DefineCircle = ThisDrawing.ModelSpace.AddCircle(pp, 25)
     Set TextObj = ThisDrawing.ModelSpace.AddText(ii - 1, pp, 20)
     
     With TextObj
        .Alignment = acAlignmentMiddleCenter
        .TextAlignmentPoint = DefineCircle.Center
     End With
     DefineCircle.color = ii
   Next ii
   
End Sub