获取CAD中线的每个节点坐标程序设计

获取CAD中线的每个节点坐标，线包括polyline、3D polyline、Spline等等！

程序代码如下：

Imports System

Imports System.IO

Imports System.Math

Public Class 获取CAD中点坐标

    Public AcadApp As AutoCAD.AcadApplication

    Public xx(), yy(), zz() As Double

    Public Count As Integer

    Public returnObj As Object

    Public FolderPath As String = "C:/"

    Public StepNum As Integer = 0

    Private Declare Auto Function SetProcessWorkingSetSize Lib "kernel32.dll" (ByVal procHandle As IntPtr, ByVal min As Int32, ByVal max As Int32) As Boolean

    Public Sub SetProcessWorkingSetSize()   '节约系统内存

        Try

            Dim Mem As Process

            Mem = Process.GetCurrentProcess()

            SetProcessWorkingSetSize(Mem.Handle, -1, -1)

        Catch ex As Exception

            MsgBox(ex.ToString)

        End Try

    End Sub

    Public Sub 启动CAD()

        On Error Resume Next

        AcadApp = GetObject(, "AutoCAD.Application")

        If Err.Number Then

            Err.Clear()

            AcadApp = CreateObject("AutoCAD.Application")

        End If

        AcadApp.Visible = True

        AcadApp.WindowState = AutoCAD.AcWindowState.acMax

        AppActivate(AcadApp.Caption)

    End Sub

    Public Sub 获取样条线节点坐标()

        Dim i As Integer

        For i = 0 To 10000 Step StepNum

            On Error GoTo handle01

            Count = i

            ReDim Preserve xx(i)

            ReDim Preserve yy(i)

            ReDim Preserve zz(i)

            xx(i) = returnObj.Coordinate(i)(0)

            yy(i) = returnObj.Coordinate(i)(1)

            zz(i) = returnObj.elevation

        Next

handle01:

        Count = Count - 1

    End Sub

    Public Sub 获取Spline线节点坐标()

        Dim fitPoints As Object

        Dim i As Integer

        For i = 0 To returnObj.NumberOfControlPoints - 1 Step StepNum

            fitPoints = returnObj.GetControlPoint(i)

            Count = i

            ReDim Preserve xx(i)

            ReDim Preserve yy(i)

            ReDim Preserve zz(i)

            xx(i) = fitPoints(0)

            yy(i) = fitPoints(1)

            zz(i) = fitPoints(2)

        Next

    End Sub

    Public Sub 获取Spline线拟合点坐标()

        Dim fitPoints As Object

        Dim pp As AutoCAD.AcadSpline

        Dim i As Integer

        For i = 0 To returnObj.NumberOfFitPoints - 1 Step StepNum

            fitPoints = returnObj.GetFitPoint(i)

            Count = i

            ReDim Preserve xx(i)

            ReDim Preserve yy(i)

            ReDim Preserve zz(i)

            xx(i) = fitPoints(0)

            yy(i) = fitPoints(1)

            zz(i) = fitPoints(2)

        Next

    End Sub

    Public Sub 获取line线节点坐标()

        Dim StartPoints As Object

        Dim EndPoints As Object

        ReDim Preserve xx(1)

        ReDim Preserve yy(1)

        ReDim Preserve zz(1)

        Count = 1

        returnObj.highlight(True)

        StartPoints = returnObj.StartPoint

        EndPoints = returnObj.EndPoint

        xx(0) = StartPoints(0)

        yy(0) = StartPoints(1)

        zz(0) = StartPoints(2)

        xx(1) = EndPoints(0)

        yy(1) = EndPoints(1)

        zz(1) = EndPoints(2)

    End Sub

    Public Sub 获取2DPolyline节点坐标()

        'Dim sss As AutoCAD.AcadLWPolyline

        returnObj.highlight(True)

        Dim i As Integer

        For i = 0 To 10000 Step StepNum

            On Error GoTo handle01

            Count = i

            ReDim Preserve xx(i)

            ReDim Preserve yy(i)

            ReDim Preserve zz(i)

            xx(i) = returnObj.Coordinate(i)(0)

            yy(i) = returnObj.Coordinate(i)(1)

            zz(i) = returnObj.elevation

        Next

handle01:

        Count = Count - 1

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        On Error GoTo handle01

        Call 启动CAD()

        Dim basePnt As Object

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)

        returnObj.highlight(True)

        '判断线的类型

        Dim LineTypenName As String

        LineTypenName = returnObj.ObjectName.ToString()

        If LineTypenName = "AcDbLine" Then

            Call 获取line线节点坐标()

        ElseIf LineTypenName = "AcDbSpline" Then

            Call 获取Spline线节点坐标()

        ElseIf LineTypenName = "AcDbPolyline" Then

            Call 获取样条线节点坐标()

        Else : Exit Sub

        End If

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate()

        End If

        Dim i As Integer

        Dim s As String = ""

        For i = 0 To Count

            s = s + xx(i).ToString() + 

        Next

        RichTextBox1.Text = s

        Button3.Enabled = True

        AppActivate(Me.Text)

        Exit Sub

handle01:

        MsgBox(Err.Description)

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        On Error GoTo handle01

        Dim dg As New OpenFileDialog

        dg.Filter = "CAD files (*.dwg)|*.dwg|All files (*.*)|*.*"

        dg.ShowDialog()

        Dim s As String = dg.FileName

        If s = "" Then Exit Sub

        启动CAD()

        AcadApp.Application.Documents.Open(s)

        AcadApp.ActiveDocument.WindowState = AutoCAD.AcWindowState.acMax

        AppActivate(Me.Text)

        Button1.Enabled = True

        Exit Sub

handle01:

        MsgBox(Err.Description)

    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        On Error GoTo handle01

        Dim dg As New SaveFileDialog

        dg.Filter = "txt files (*.txt)|*.txt|dat files (*.dat)|*.dat"

        dg.ShowDialog()

        Dim s As String = dg.FileName

        Dim i As Integer

        Dim s1 As String = ""

        Using sw As StreamWriter = New StreamWriter(s)

            For i = 0 To Count

                s1 = xx(i).ToString() + 

                sw.WriteLine(s1)

            Next

            sw.Close()

        End Using

        Exit Sub

handle01:

        MsgBox(Err.Description)

    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        AcadApp.ActiveDocument.Regen(AutoCAD.AcRegenType.acActiveViewport)

    End Sub

    Public Sub CalculateCoordinate()

        On Error GoTo handle01

        Dim x0, y0, Rotangle As Double

        x0 = TextBox1.Text

        y0 = TextBox2.Text

        Rotangle = (TextBox4.Text) * 3.1415926 / 180

        Dim i As Integer

        Dim x1, y1 As Double

        If Cos(Rotangle) = 0 Then

            For i = 0 To Count

                x1 = xx(i)

                xx(i) = yy(i) - y0

                yy(i) = x0 - x1

            Next

            Exit Sub

        End If

        For i = 0 To Count

            y1 = (yy(i) - y0 - (xx(i) - x0) * Tan(Rotangle)) * Cos(Rotangle)

            x1 = (xx(i) - x0) / Cos(Rotangle) + y1 * Tan(Rotangle)

            If Abs(x1) < 0.00001 Then x1 = 0 '设置精度

            If Abs(y1) < 0.00001 Then y1 = 0

            xx(i) = x1

            yy(i) = y1

        Next

        Exit Sub

handle01:

        MsgBox(Err.Description)

    End Sub

    Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged

    End Sub

    Private Sub 批量获取节点坐标Button_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 批量获取节点坐标Button.Click

        Static ExitNum As Integer

        On Error GoTo handle01

        Static SaveNum As Integer

        Call 启动CAD()

        Dim basePnt As Object

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)

        returnObj.highlight(True)

        AcadApp.ActiveDocument.SendCommand("@选取下一条线!连续在空白地方点击两次将会自动退出批量存储状态!" + vbCr)

        '判断线的类型

        Dim LineTypenName As String

        LineTypenName = returnObj.ObjectName.ToString()

        If LineTypenName = "AcDbLine" Then

            Call 获取line线节点坐标()

        ElseIf LineTypenName = "AcDbSpline" Then

            Call 获取Spline线节点坐标()

        ElseIf LineTypenName = "AcDbPolyline" Then

            Call 获取样条线节点坐标()

        End If

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate()

        End If

        Dim j As Integer

        Dim s1 As String = ""

        Using sw As StreamWriter = New StreamWriter(FolderPath + SaveNum.ToString() + ".txt")

            For j = 0 To Count

                s1 = xx(j).ToString() + 

                sw.WriteLine(s1)

            Next

            sw.Close()

            SaveNum = SaveNum + 1

        End Using

        ExitNum = 0

        Call 批量获取节点坐标Button_Click(sender, e)

        Exit Sub

handle01:

        ExitNum = ExitNum + 1

        If ExitNum = 2 Then

            ExitNum = 0

            Exit Sub

        Else : Call 批量获取节点坐标Button_Click(sender, e)

        End If

    End Sub

    Private Sub 设置文件保存路径Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 设置文件保存路径Button5.Click

        Dim fdg As FolderBrowserDialog

        fdg = New FolderBrowserDialog

        fdg.ShowDialog()

        If fdg.SelectedPath = "" Then Exit Sub

        FolderPath = fdg.SelectedPath

    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        On Error GoTo Handle01

        Call 启动CAD()

        Dim sset As AutoCAD.AcadSelectionSet

        sset = AcadApp.ActiveDocument.SelectionSets.Add("NewSelectionSet")

        ' 提示用户选择对象

        sset.SelectOnScreen()

        Dim ent As Object

        Dim sss As AutoCAD.AcadPoint

        Count = -1

        For Each ent In sset

            If ent.Objectname = "AcDbPoint" Then

                Count = Count + 1

                ReDim Preserve xx(Count)

                ReDim Preserve yy(Count)

                ReDim Preserve zz(Count)

                xx(Count) = ent.Coordinates(0)

                yy(Count) = ent.Coordinates(1)

                zz(Count) = ent.Coordinates(2)

            End If

        Next ent

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate()

        End If

        Dim i As Integer

        Dim s As String = ""

        For i = 0 To Count

            s = s + xx(i).ToString() + 

        Next

        RichTextBox1.Text = s

        AcadApp.ActiveDocument.SelectionSets.Item("NewSelectionSet").Delete()

        AppActivate(Me.Text)

        Button3.Enabled = True

        Exit Sub

Handle01:

        AcadApp.ActiveDocument.SelectionSets.Item("NewSelectionSet").Delete()

        Button5_Click(sender, e)

        MsgBox(Err.Description)

    End Sub

    Private Sub Button6_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click

        On Error GoTo Handle01

        AcadApp.ActiveDocument.Save()

Handle01:

        MsgBox(Err.Description)

    End Sub

    Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click

        Call 启动CAD()

        Dim basePnt As Object

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)

        returnObj.highlight(True)

        AppActivate(AcadApp.Caption)

        Dim i As Integer

        For i = 0 To 500

            On Error GoTo handle01

            Count = i

            ReDim Preserve xx(i)

            ReDim Preserve yy(i)

            ReDim Preserve zz(i)

            xx(i) = returnObj.Coordinate(i)(0)

            yy(i) = returnObj.Coordinate(i)(1)

            zz(i) = returnObj.Coordinate(i)(2)

        Next

handle01:

        Count = Count - 1

        Dim j As Integer

        Dim s As String = ""

        For j = 0 To Count

            s = s + xx(j).ToString() + 

        Next

        RichTextBox1.Text = s

        Button3.Enabled = True

        AppActivate(Me.Text)

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Call SetProcessWorkingSetSize()

    End Sub

    Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click

        On Error GoTo handle01

        Call 启动CAD()

        Dim basePnt As Object

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)

        returnObj.highlight(True)

        Call 获取2DPolyline节点坐标()

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate()

        End If

        Dim i As Integer

        Dim s As String = ""

        For i = 0 To Count

            s = s + xx(i).ToString() + 

        Next

        RichTextBox1.Text = s

        Button3.Enabled = True

        AppActivate(Me.Text)

        Exit Sub

handle01:

        MsgBox(Err.Description)

    End Sub

    Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click

        Call 启动CAD()

        Dim basePnt As Object

        basePnt = AcadApp.ActiveDocument.Utility.GetPoint()

        MsgBox("当前点击坐标位置为：Ｘ＝" + basePnt(0).ToString() + "，Ｙ＝" + basePnt(1).ToString())

    End Sub

    Private Sub 打开CAD文件OToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 打开CAD文件OToolStripMenuItem.Click

        On Error GoTo handle01

        Dim dg As New OpenFileDialog

        dg.Filter = "CAD files (*.dwg)|*.dwg|All files (*.*)|*.*"

        dg.ShowDialog()

        Dim s As String = dg.FileName

        If s = "" Then Exit Sub

        启动CAD()

        AcadApp.Application.Documents.Open(s)

        AcadApp.ActiveDocument.WindowState = AutoCAD.AcWindowState.acMax

        AppActivate(Me.Text)

        Button1.Enabled = True

        Exit Sub

handle01:

        MsgBox(Err.Description)

    End Sub

    Private Sub 保存CAD文件CToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 保存CAD文件CToolStripMenuItem.Click

        On Error GoTo Handle01

        AcadApp.ActiveDocument.Save()

        Exit Sub

Handle01:

        MsgBox(Err.Description)

    End Sub

获取CAD中线的每个节点坐标程序设计（二）

 Private Sub 保存坐标数据文件SToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 保存坐标数据文件SToolStripMenuItem.Click 

        On Error GoTo handle01 

        Dim dg As New SaveFileDialog 

        dg.Filter = "txt files (*.txt)|*.txt|dat files (*.dat)|*.dat" 

        dg.ShowDialog() 

        Dim s As String = dg.FileName 

        Dim i As Integer 

        Dim s1 As String = "" 

        Using sw As StreamWriter = New StreamWriter(s) 

            For i = 0 To Count 

                s1 = xx(i).ToString() + 

                sw.WriteLine(s1) 

            Next 

            sw.Close() 

        End Using 

        Exit Sub 

handle01: 

        MsgBox(Err.Description) 

    End Sub    Private Sub 刷新CAD图形RToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 刷新CAD图形RToolStripMenuItem.Click 

        On Error GoTo Handle01 

        AcadApp.ActiveDocument.Regen(AutoCAD.AcRegenType.acActiveViewport) 

        Exit Sub 

Handle01: 

        MsgBox(Err.Description) 

    End Sub 

    Private Sub 退出EToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 退出EToolStripMenuItem1.Click 

        On Error GoTo Handle01 

        Application.Exit() 

        Exit Sub 

Handle01: 

        MsgBox(Err.Description) 

    End Sub 

    Private Sub 获取线条上节点坐标LToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取线条上节点坐标LToolStripMenuItem1.Click 

        On Error GoTo handle01 

        Call 启动CAD() 

        Dim basePnt As Object 

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt) 

        returnObj.highlight(True) 

        '判断线的类型 

        Dim LineTypenName As String 

        LineTypenName = returnObj.ObjectName.ToString() 

        If LineTypenName = "AcDbLine" Then 

            Call 获取line线节点坐标() 

        ElseIf LineTypenName = "AcDbSpline" Then 

            Call 获取Spline线拟合点坐标() 

        ElseIf LineTypenName = "AcDbPolyline" Then 

            Call 获取样条线节点坐标() 

        Else : Exit Sub 

        End If 

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate() 

        End If 

        Dim i As Integer 

        Dim s As String = "" 

        For i = 0 To Count 

            s = s + xx(i).ToString() + 

        Next 

        RichTextBox1.Text = s 

        Button3.Enabled = True 

        AppActivate(Me.Text) 

        Exit Sub 

handle01: 

        MsgBox(Err.Description) 

    End Sub 

    Private Sub 获取多段线上节点坐标SToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取多段线上节点坐标SToolStripMenuItem.Click 

        On Error GoTo handle01 

        Call 启动CAD() 

        Dim basePnt As Object 

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt) 

        returnObj.highlight(True) 

        '判断线的类型 

        Dim LineTypenName As String 

        LineTypenName = returnObj.ObjectName.ToString() 

        If LineTypenName = "AcDbPolyline" Then 

            Call 获取样条线节点坐标() 

        Else : Exit Sub 

        End If 

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate() 

        End If 

        Dim i As Integer 

        Dim s As String = "" 

        For i = 0 To Count 

            s = s + xx(i).ToString() + 

        Next 

        RichTextBox1.Text = s 

        Button3.Enabled = True 

        AppActivate(Me.Text) 

        Exit Sub 

handle01: 

        MsgBox(Err.Description) 

    End Sub 

    Private Sub 获取样条线上节点坐标ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取样条线上节点坐标ToolStripMenuItem.Click 

        On Error GoTo handle01 

        Call 启动CAD() 

        Dim basePnt As Object 

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt) 

        returnObj.highlight(True) 

        '判断线的类型 

        Dim LineTypenName As String 

        LineTypenName = returnObj.ObjectName.ToString() 

        If LineTypenName = "AcDbSpline" Then 

            Call 获取Spline线节点坐标() 

        Else : Exit Sub 

        End If 

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate() 

        End If 

        Dim i As Integer 

        Dim s As String = "" 

        For i = 0 To Count 

            s = s + xx(i).ToString() + 

        Next 

        RichTextBox1.Text = s 

        Button3.Enabled = True 

        AppActivate(Me.Text) 

        Exit Sub 

handle01: 

        MsgBox(Err.Description) 

    End Sub 

    Private Sub 获取样条线上拟合点坐标NToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取样条线上拟合点坐标NToolStripMenuItem.Click 

        On Error GoTo handle01 

        Call 启动CAD() 

        Dim basePnt As Object 

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt) 

        returnObj.highlight(True) 

        '判断线的类型 

        Dim LineTypenName As String 

        LineTypenName = returnObj.ObjectName.ToString() 

        If LineTypenName = "AcDbSpline" Then 

            Call 获取Spline线拟合点坐标() 

        Else : Exit Sub 

        End If 

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate() 

        End If 

        Dim i As Integer 

        Dim s As String = "" 

        For i = 0 To Count 

            s = s + xx(i).ToString() + 

        Next 

        RichTextBox1.Text = s 

        Button3.Enabled = True 

        AppActivate(Me.Text) 

        Exit Sub 

handle01: 

        MsgBox(Err.Description) 

    End Sub 

    Private Sub 获取点的坐标DToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取点的坐标DToolStripMenuItem1.Click 

        On Error GoTo Handle01 

        Call 启动CAD() 

        Dim sset As AutoCAD.AcadSelectionSet 

        sset = AcadApp.ActiveDocument.SelectionSets.Add("NewSelectionSet") 

        ' 提示用户选择对象 

        sset.SelectOnScreen() 

        Dim ent As Object 

        Dim sss As AutoCAD.AcadPoint 

        Count = -1 

        For Each ent In sset 

            If ent.Objectname = "AcDbPoint" Then 

                Count = Count + 1 

                ReDim Preserve xx(Count) 

                ReDim Preserve yy(Count) 

                ReDim Preserve zz(Count) 

                xx(Count) = ent.Coordinates(0) 

                yy(Count) = ent.Coordinates(1) 

                zz(Count) = ent.Coordinates(2) 

            End If 

        Next ent 

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate() 

        End If 

        Dim i As Integer 

        Dim s As String = "" 

        For i = 0 To Count 

            s = s + xx(i).ToString() + 

        Next 

        RichTextBox1.Text = s 

        AcadApp.ActiveDocument.SelectionSets.Item("NewSelectionSet").Delete() 

        AppActivate(Me.Text) 

        Button3.Enabled = True 

        Exit Sub 

Handle01: 

        AcadApp.ActiveDocument.SelectionSets.Item("NewSelectionSet").Delete() 

        Call 获取点的坐标DToolStripMenuItem1_Click(sender, e) 

        MsgBox(Err.Description) 

    End Sub 

    Private Sub 设置自动保存路径ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 设置自动保存路径ToolStripMenuItem.Click 

        Dim fdg As FolderBrowserDialog 

        fdg = New FolderBrowserDialog 

        fdg.ShowDialog() 

        If fdg.SelectedPath = "" Then Exit Sub 

        FolderPath = fdg.SelectedPath 

    End Sub 

    Private Sub 取线条上节点坐标并自动保存LToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取线条上节点坐标获取线条上节点坐标并自动保存LToolStripMenuItem2.Click 

        Static ExitNum As Integer 

        On Error GoTo handle01 

        Static SaveNum As Integer 

        Call 启动CAD() 

        Dim basePnt As Object 

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt) 

        returnObj.highlight(True) 

        AcadApp.ActiveDocument.SendCommand("@选取下一条线!连续在空白地方点击两次将会自动退出批量存储状态!" + vbCr) 

        '判断线的类型 

        Dim LineTypenName As String 

        LineTypenName = returnObj.ObjectName.ToString() 

        If LineTypenName = "AcDbLine" Then 

            Call 获取line线节点坐标() 

        ElseIf LineTypenName = "AcDbSpline" Then 

            Call 获取Spline线节点坐标() 

        ElseIf LineTypenName = "AcDbPolyline" Then 

            Call 获取样条线节点坐标() 

        End If 

        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then

            Call CalculateCoordinate() 

        End If 

        Dim j As Integer 

        Dim s1 As String = "" 

        Using sw As StreamWriter = New StreamWriter(FolderPath + SaveNum.ToString() + ".txt") 

            For j = 0 To Count 

                s1 = xx(j).ToString() + 

                sw.WriteLine(s1) 

            Next 

            sw.Close() 

            SaveNum = SaveNum + 1 

        End Using 

        ExitNum = 0 

        Call 取线条上节点坐标并自动保存LToolStripMenuItem2_Click(sender, e) 

        Exit Sub 

handle01: 

        ExitNum = ExitNum + 1 

        If ExitNum = 2 Then 

            ExitNum = 0 

            Exit Sub 

        Else : Call 取线条上节点坐标并自动保存LToolStripMenuItem2_Click(sender, e) 

        End If 

    End Sub 

    Private Sub 获取3D多段线上节点坐标TToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取3D多段线上节点坐标TToolStripMenuItem.Click 

        Call 启动CAD() 

        Dim basePnt As Object 

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt) 

        returnObj.highlight(True) 

        AppActivate(AcadApp.Caption) 

        If returnObj.objectname = "AcDb3DPolyline" Then 

            Dim i As Integer 

            For i = 0 To 500 

                On Error GoTo handle01 

                Count = i 

                ReDim Preserve xx(i) 

                ReDim Preserve yy(i) 

                ReDim Preserve zz(i) 

                xx(i) = returnObj.Coordinate(i)(0) 

                yy(i) = returnObj.Coordinate(i)(1) 

                zz(i) = returnObj.Coordinate(i)(2) 

            Next 

handle01: 

            Count = Count - 1 

            Dim j As Integer 

            Dim s As String = "" 

            For j = 0 To Count 

                s = s + xx(j).ToString() + 

            Next 

            RichTextBox1.Text = s 

            Button3.Enabled = True 

            AppActivate(Me.Text) 

        Else 

            MsgBox(Err.Description) 

        End If 

    End Sub 

    Private Sub 查询实体的对象名称OToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 查询实体的对象名称OToolStripMenuItem.Click 

        On Error GoTo handle1 

        Call 启动CAD() 

        Dim basePnt As Object 

        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt) 

        returnObj.highlight(True) 

        AppActivate(AcadApp.Caption) 

        MsgBox(returnObj.objectname) 

        Exit Sub 

handle1: 

        MsgBox(Err.Description) 

    End Sub 

    Private Sub TextBox3_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox3.TextChanged 

        StepNum = CInt(TextBox3.Text) 

    End Sub 

    Private Sub 获取线上节点坐标并绘制该节点DToolStripMenuItem_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取线上节点坐标并绘制该节点DToolStripMenuItem.Click 

        On Error GoTo handle01 

        Call 启动CAD() 

        Dim sset As AutoCAD.AcadSelectionSet 

        sset = AcadApp.ActiveDocument.SelectionSets.Add("NewSelectionSet01") 

        ' 提示用户选择对象 

        sset.SelectOnScreen() 

        Dim ent As Object 

        Dim entObjectname As String 

        Dim i As Integer 

        Timer1.Enabled = True 

        Dim ProgressForm As New Form2   '定义进程窗体 

        ProgressForm.Show() 

        AppActivate(ProgressForm.Text) 

        For Each ent In sset 

            entObjectname = ent.Objectname 

            returnObj = ent 

            If entObjectname = "AcDbPolyline" Then 

                Call 获取样条线节点坐标() 

            ElseIf entObjectname = "AcDbLine" Then 

                Call 获取line线节点坐标() 

            ElseIf entObjectname = "AcDbSpline" Then 

                Call 获取Spline线拟合点坐标() 

            ElseIf entObjectname = "AcDb2dPolyline" Then 

                Call 获取2DPolyline节点坐标() 

            End If 

            Call 绘制点() 

            i += 1 

            ProgressForm.Refresh() 

            ProgressForm.ProgressBar1.Value = (i / sset.Count) * 100 

            ProgressForm.Label1.Text = "已完成：" + Format(((i / sset.Count) * 100), "##.##") + "%" 

        Next ent 

        AcadApp.ActiveDocument.SelectionSets.Item("NewSelectionSet01").Delete() 

        ProgressForm.Close() 

        MsgBox("执行完成！") 

        Exit Sub 

handle01: 

        AcadApp.ActiveDocument.SelectionSets.Item("NewSelectionSet01").Delete() 

        MsgBox(Err.Description) 

    End Sub 

    Public Sub 绘制点() 

        Dim i As Integer 

        Dim ppoint(2) As Double 

        For i = 0 To Count 

            ppoint(0) = xx(i) 

            ppoint(1) = yy(i) 

            ppoint(2) = zz(i) 

            AcadApp.ActiveDocument.ModelSpace.AddPoint(ppoint) 

        Next 

        ReDim xx(0) 

        ReDim yy(0) 

        ReDim zz(0) 

        Count = -1 

    End Sub 

End Class