自己写的一个根据polyline生成顶点坐标表格的程序!

Imports System
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.Geometry
Namespace MyTools
    ''' <summary>
    ''' TestClass的说明。
    ''' </summary>
    Public Class TestClass
        Public Sub New()
        End Sub
        Public Sub CreateTable(ByVal p3dC As Point3dCollection, ByVal scale As String, ByVal p3d As Point3d, ByVal t As Integer)
            Dim numRows As Integer = p3dC.Count + 1
            Dim strT As String
            If t = 3 Then
                strT = "#0.000"
            Else
                strT = "#0.00"
            End If
            Dim db As Database = HostApplicationServices.WorkingDatabase
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            Dim trans As Transaction = db.TransactionManager.StartTransaction()
            Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
            Dim btr As BlockTableRecord = DirectCast(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
            Dim dScale As Double = Double.Parse(scale)
            Dim rowHeight As Double
            Dim columnWidth1 As Double
            Dim columnWidth2 As Double
            Dim textHeight1 As Double
            Dim textHeight2 As Double
            Dim columnWidth3 As Double
            Try
                textHeight1 = 1.25 * (dScale / 500)
                '表头的字体高度
                textHeight2 = 0.9 * (dScale / 500)
                '坐标点的数字字体高度
                rowHeight = 2 * (dScale / 500)
                '行高
                columnWidth1 = 4 * (dScale / 500)
                '1列的列宽
                columnWidth2 = 11 * (dScale / 500)
                '2至3列的列宽
                columnWidth3 = 6 * (dScale / 500)
                '4列的列宽
                Dim myTable As New Table()
                myTable.Position = p3d
                myTable.NumRows = numRows
                myTable.NumColumns = 4
                myTable.SetColumnWidth(0, columnWidth1)
                myTable.SetColumnWidth(1, columnWidth2)
                myTable.SetColumnWidth(2, columnWidth2)
                myTable.SetColumnWidth(3, columnWidth3)
                myTable.SetRowHeight(rowHeight)
                ed.WriteMessage(rowHeight.ToString())
                '设置表头
                myTable.SetTextHeight(0, 0, textHeight1)
                myTable.SetTextString(0, 0, "序号")
                myTable.SetTextHeight(0, 1, textHeight1)
                myTable.SetTextString(0, 1, "X坐标")
                myTable.SetTextHeight(0, 2, textHeight1)
                myTable.SetTextString(0, 2, "Y坐标")
                myTable.SetTextHeight(0, 3, textHeight1)
                myTable.SetTextString(0, 3, "圆弧标记")
                '将坐标数值输入到表格中
                Dim i As Integer = 0
                While i < p3dC.Count
                    Dim n As Integer = i + 1
                    myTable.SetTextHeight(n, 0, textHeight2)
                    myTable.SetTextString(n, 0, n.ToString())
                    myTable.SetTextHeight(n, 1, textHeight2)
                    myTable.SetTextString(n, 1, p3dC.X.ToString(strT))
                    myTable.SetTextHeight(n, 2, textHeight2)
                    myTable.SetTextString(n, 2, p3dC.Y.ToString(strT))
                    myTable.SetTextHeight(n, 3, textHeight2)
                    myTable.SetTextString(n, 3, p3dC.Z.ToString())
                    System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
                End While
                btr.AppendEntity(myTable)
                trans.AddNewlyCreatedDBObject(myTable, True)
                trans.Commit()
            Catch ex As System.Exception
                Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("输入的比例尺有误，请重新输入" + ex.Message.ToString())
            Finally
                trans.Dispose()
            End Try
        End Sub
        Private Shared Function GetPLPoint(ByVal PLid As ObjectId) As Point3dCollection
            '并非真正的3d集合，Z如果是1的话表示此点是圆弧的中点
            Dim p3dCollection As New Point3dCollection()
            Dim trans As Transaction = Autodesk.AutoCAD.DatabaseServices.HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction()
            Using trans
                Dim obj As DBObject = trans.GetObject(PLid, OpenMode.ForRead)
                If obj.[GetType]().Name = "Polyline" Then
                    '此语句可获得所获取对象obj的类型，如Polyline,Arc,Circle等。
                    Dim PL As Polyline = TryCast(obj, Polyline)
                    Dim vn As Integer = PL.NumberOfVertices
                    Dim i As Integer = 0
                    While i < vn
                        Dim vBulge As Double = PL.GetBulgeAt(i)
                        If vBulge <> 0 Then
                            p3dCollection.Add(PL.GetPoint3dAt(i))
                            Dim len0 As Double = PL.GetDistAtPoint(PL.GetPoint3dAt(i))
                            Dim len1 As Double = PL.GetDistAtPoint(PL.GetPoint3dAt(i + 1))
                            Dim midlen As Double = (len0 + len1) / 2
                            Dim midP3d As Point3d = PL.GetPointAtDist(midlen)
                            Dim m As New Point3d(midP3d.X, midP3d.Y, 1)
                            p3dCollection.Add(m)
                        Else
                            p3dCollection.Add(PL.GetPoint3dAt(i))
                        End If
                        System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
                    End While
                End If
                trans.Commit()
                trans.Dispose()
                Return p3dCollection
            End Using
        End Function
        <CommandMethod("zbb")> _
        Public Sub CreateVertexTable()
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            Dim per As PromptEntityResult = ed.GetEntity(vbLf & "请选择多段线")
            Dim p3dCo As Point3dCollection = GetPLPoint(per.ObjectId)
            If per.Status <> PromptStatus.OK Then
                ed.WriteMessage(vbLf & "选择选段错误")
            End If
            Dim i As Integer = 0
            While i < p3dCo.Count
                Dim point3dd As Point3d = p3dCo
                ed.WriteMessage(vbLf + point3dd.ToString())
                System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
            End While
            Dim p3d As Point3d
            Dim prPointOptions As New PromptPointOptions(vbLf & "请选择表格插入点：")
            Dim prPointRes As PromptPointResult = ed.GetPoint(prPointOptions)
            If prPointRes.Status = PromptStatus.OK Then
                p3d = prPointRes.Value
            End If

            Dim pso As New PromptStringOptions(vbLf & "请输入比例尺：")
            Dim prScale As PromptResult = ed.GetString(pso)
            Dim strScale As String = prScale.StringResult.ToString()
            If prScale.Status <> PromptStatus.OK Then
                ed.WriteMessage(vbLf & "输入比例尺错误")
            End If

            Dim opt As New PromptKeywordOptions(vbLf & "选择小数位数[三位(3)]<两位(2)>")
            opt.Keywords.Add("3")
            opt.Keywords.Add("2")
            Dim result As PromptResult = ed.GetKeywords(opt)
            If result.Status = PromptStatus.OK Then
                Select Case result.StringResult
                    Case "3"
                        CreateTable(p3dCo, strScale, p3d, 3)
                        Exit Select
                    Case "2"
                        CreateTable(p3dCo, strScale, p3d, 2)
                        Exit Select
                End Select
            End If
        End Sub
    End Class
End Namespace