获取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() + "," + yy(i).ToString() + "," + zz(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() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)
        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() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)
        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() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)
        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() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)
        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() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)
        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() + "," + yy(j).ToString() + "," + zz(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() + "," + yy(j).ToString() + "," + zz(j).ToString() + Chr(13)
            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