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

1、获取CAD中线的每个节点坐标程序设计（一） 获取CAD中线的每个节点坐标，线包括polyline、3D polyline、Spline等等！程序代码如下：Imports SystemImports System.IOImports System.MathPublic Class 获取CAD中点坐标    Public AcadApp As AutoCAD.AcadApplication    Public xx(), yy(), zz() As Double    Publi

2、c 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" (B

3、yVal procHandle As IntPtr, ByVal min As Int32, ByVal max As Int32) As Boolean    Public Sub SetProcessWorkingSetSize()   '节约系统内存        Try            Dim Mem As Proc

4、ess            Mem = Process.GetCurrentProcess()            SetProcessWorkingSetSize(Mem.Handle, -1, -1)        Catch ex As Exception &

5、#160;          MsgBox(ex.ToString)        End Try    End Sub    Public Sub 启动CAD()        On Error Resume Next   &#

6、160;    AcadApp = GetObject(, "AutoCAD.Application")        If Err.Number Then            Err.Clear()           

7、60;AcadApp = CreateObject("AutoCAD.Application")        End If        AcadApp.Visible = True        AcadApp.WindowState = AutoCAD.AcWindowState.acMax   

8、60;    AppActivate(AcadApp.Caption)    End Sub    Public Sub 获取样条线节点坐标()        Dim i As Integer        For i = 0 To 10000 Step StepNum    &

9、#160;       On Error GoTo handle01            Count = i            ReDim Preserve xx(i)         

10、0;  ReDim Preserve yy(i)            ReDim Preserve zz(i)            xx(i) = returnObj.Coordinate(i)(0)           &#

11、160;yy(i) = returnObj.Coordinate(i)(1)            zz(i) = returnObj.elevation        Nexthandle01:        Count = Count - 1    End Sub 

12、   Public Sub 获取Spline线节点坐标()        Dim fitPoints As Object        Dim i As Integer        For i = 0 To returnObj.NumberOfControlPoints - 1 Step StepNum  

13、          fitPoints = returnObj.GetControlPoint(i)            Count = i            ReDim Preserve xx(i)    

14、60;       ReDim Preserve yy(i)            ReDim Preserve zz(i)            xx(i) = fitPoints(0)        

15、60;   yy(i) = fitPoints(1)            zz(i) = fitPoints(2)        Next    End Sub    Public Sub 获取Spline线拟合点坐标()     

16、60;  Dim fitPoints As Object        Dim pp As AutoCAD.AcadSpline        Dim i As Integer        For i = 0 To returnObj.NumberOfFitPoints - 1 Step StepNum   

17、;         fitPoints = returnObj.GetFitPoint(i)            Count = i            ReDim Preserve xx(i)      

18、      ReDim Preserve yy(i)            ReDim Preserve zz(i)            xx(i) = fitPoints(0)          

19、  yy(i) = fitPoints(1)            zz(i) = fitPoints(2)        Next    End Sub    Public Sub 获取line线节点坐标()       

20、60;Dim StartPoints As Object        Dim EndPoints As Object        ReDim Preserve xx(1)        ReDim Preserve yy(1)        ReDim Preserve zz

21、(1)        Count = 1        returnObj.highlight(True)        StartPoints = returnObj.StartPoint        EndPoints = returnObj.EndPoint &

22、#160;      xx(0) = StartPoints(0)        yy(0) = StartPoints(1)        zz(0) = StartPoints(2)        xx(1) = EndPoints(0)     

23、;   yy(1) = EndPoints(1)        zz(1) = EndPoints(2)    End Sub    Public Sub 获取2DPolyline节点坐标()        'Dim sss As AutoCAD.AcadLWPolyline    

24、;    returnObj.highlight(True)        Dim i As Integer        For i = 0 To 10000 Step StepNum            On Error GoTo handle01  &

25、#160;         Count = i            ReDim Preserve xx(i)            ReDim Preserve yy(i)        

26、    ReDim Preserve zz(i)            xx(i) = returnObj.Coordinate(i)(0)            yy(i) = returnObj.Coordinate(i)(1)       &#

27、160;    zz(i) = returnObj.elevation        Nexthandle01:        Count = Count - 1    End Sub    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e

28、 As System.EventArgs) Handles Button1.Click        On Error GoTo handle01        Call 启动CAD()        Dim basePnt As Object        AcadApp.Ac

29、tiveDocument.Utility.GetEntity(returnObj, basePnt)        returnObj.highlight(True)        '判断线的类型        Dim LineTypenName As String       &

30、#160;LineTypenName = returnObj.ObjectName.ToString()        If LineTypenName = "AcDbLine" Then            Call 获取line线节点坐标()        ElseIf LineTypenNa

31、me = "AcDbSpline" Then            Call 获取Spline线节点坐标()        ElseIf LineTypenName = "AcDbPolyline" Then            Call

32、 获取样条线节点坐标()        Else : Exit Sub        End If        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then      

33、;      Call CalculateCoordinate()        End If        Dim i As Integer        Dim s As String = ""       

34、; For i = 0 To Count            s = s + xx(i).ToString() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)        Next        

35、;RichTextBox1.Text = s        Button3.Enabled = True        AppActivate(Me.Text)        Exit Subhandle01:        MsgBox(Err.Description)

36、0;   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 OpenFileDi

37、alog        dg.Filter = "CAD files (*.dwg)|*.dwg|All files (*.*)|*.*"        dg.ShowDialog()        Dim s As String = dg.FileName       

38、; If s = "" Then Exit Sub        启动CAD()        AcadApp.Application.Documents.Open(s)        AcadApp.ActiveDocument.WindowState = AutoCAD.AcWindowState.acMax &#

39、160;      AppActivate(Me.Text)        Button1.Enabled = True        Exit Subhandle01:        MsgBox(Err.Description)    End Sub

40、60;   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    &#

41、160;   dg.Filter = "txt files (*.txt)|*.txt|dat files (*.dat)|*.dat"        dg.ShowDialog()        Dim s As String = dg.FileName        Dim i As Integer

42、60;       Dim s1 As String = ""        Using sw As StreamWriter = New StreamWriter(s)            For i = 0 To Count      

43、0;         s1 = xx(i).ToString() + "," + yy(i).ToString() + "," + zz(i).ToString()                sw.WriteLine(s1)       

44、;     Next            sw.Close()        End Using        Exit Subhandle01:        MsgBox(Err.De

45、scription)    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)  &#

46、160; End Sub    Public Sub CalculateCoordinate()        On Error GoTo handle01        Dim x0, y0, Rotangle As Double        x0 = TextBox1.Text  &

47、#160;     y0 = TextBox2.Text        Rotangle = (TextBox4.Text) * 3.1415926 / 180        Dim i As Integer        Dim x1, y1 As Double    

48、;    If Cos(Rotangle) = 0 Then            For i = 0 To Count                x1 = xx(i)         

49、       xx(i) = yy(i) - y0                yy(i) = x0 - x1            Next         

50、;   Exit Sub        End If        For i = 0 To Count            y1 = (yy(i) - y0 - (xx(i) - x0) * Tan(Rotangle) * Cos(Rotangle)   

51、         x1 = (xx(i) - x0) / Cos(Rotangle) + y1 * Tan(Rotangle)            If Abs(x1) < 0.00001 Then x1 = 0 '设置精度            If

52、Abs(y1) < 0.00001 Then y1 = 0            xx(i) = x1            yy(i) = y1        Next        Exit

53、 Subhandle01:        MsgBox(Err.Description)    End Sub    Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged    End Sub 

54、60;  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   

55、60;    Static SaveNum As Integer        Call 启动CAD()        Dim basePnt As Object        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)  

56、;      returnObj.highlight(True)        AcadApp.ActiveDocument.SendCommand("选取下一条线!连续在空白地方点击两次将会自动退出批量存储状态!" + vbCr)        '判断线的类型       

57、60;Dim LineTypenName As String        LineTypenName = returnObj.ObjectName.ToString()        If LineTypenName = "AcDbLine" Then            Call 获取line

58、线节点坐标()        ElseIf LineTypenName = "AcDbSpline" Then            Call 获取Spline线节点坐标()        ElseIf LineTypenName = "AcDbPolyline" Then

59、60;           Call 获取样条线节点坐标()        End If        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then    &

60、#160;       Call CalculateCoordinate()        End If        Dim j As Integer        Dim s1 As String = ""     

61、   Using sw As StreamWriter = New StreamWriter(FolderPath + SaveNum.ToString() + ".txt")            For j = 0 To Count                s

62、1 = xx(j).ToString() + "," + yy(j).ToString() + "," + zz(j).ToString()                sw.WriteLine(s1)            Next   

63、0;        sw.Close()            SaveNum = SaveNum + 1        End Using        ExitNum = 0     &

64、#160;  Call 批量获取节点坐标Button_Click(sender, e)        Exit Subhandle01:        ExitNum = ExitNum + 1        If ExitNum = 2 Then       

65、0;    ExitNum = 0            Exit Sub        Else : Call 批量获取节点坐标Button_Click(sender, e)        End If    End Sub &

66、#160;  Private Sub 设置文件保存路径Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 设置文件保存路径Button5.Click        Dim fdg As FolderBrowserDialog        fdg = New FolderBrowserDialog 

67、;       fdg.ShowDialog()        If fdg.SelectedPath = "" Then Exit Sub        FolderPath = fdg.SelectedPath    End Sub    Private Sub B

68、utton5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click        On Error GoTo Handle01        Call 启动CAD()        Dim sset As AutoCAD.AcadSele

69、ctionSet        sset = AcadApp.ActiveDocument.SelectionSets.Add("NewSelectionSet")        ' 提示用户选择对象        sset.SelectOnScreen()      &

70、#160; Dim ent As Object        Dim sss As AutoCAD.AcadPoint        Count = -1        For Each ent In sset           

71、0;If ent.Objectname = "AcDbPoint" Then                Count = Count + 1                ReDim Preserve xx(Count)   &

72、#160;            ReDim Preserve yy(Count)                ReDim Preserve zz(Count)             &

73、#160;  xx(Count) = ent.Coordinates(0)                yy(Count) = ent.Coordinates(1)                zz(Count) = ent.Coordinates(2)&

74、#160;           End If        Next ent        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then     &

75、#160;      Call CalculateCoordinate()        End If        Dim i As Integer        Dim s As String = ""      &

76、#160; For i = 0 To Count            s = s + xx(i).ToString() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)        Next       &

77、#160;RichTextBox1.Text = s        AcadApp.ActiveDocument.SelectionSets.Item("NewSelectionSet").Delete()        AppActivate(Me.Text)        Button3.Enabled = True 

78、60;      Exit SubHandle01:        AcadApp.ActiveDocument.SelectionSets.Item("NewSelectionSet").Delete()        Button5_Click(sender, e)       

79、60;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      

80、0; 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   

81、60;    Call 启动CAD()        Dim basePnt As Object        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)        returnObj.highlight(True)  

82、;      AppActivate(AcadApp.Caption)        Dim i As Integer        For i = 0 To 500            On Error GoTo handle01  &

83、#160;         Count = i            ReDim Preserve xx(i)            ReDim Preserve yy(i)        

84、    ReDim Preserve zz(i)            xx(i) = returnObj.Coordinate(i)(0)            yy(i) = returnObj.Coordinate(i)(1)       &#

85、160;    zz(i) = returnObj.Coordinate(i)(2)        Nexthandle01:        Count = Count - 1        Dim j As Integer        

86、Dim s As String = ""        For j = 0 To Count            s = s + xx(j).ToString() + "," + yy(j).ToString() + "," + zz(j).ToString() + Chr(13)    

87、0;   Next        RichTextBox1.Text = s        Button3.Enabled = True        AppActivate(Me.Text)    End Sub    Private Sub Fo

88、rm1_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.Eve

89、ntArgs) Handles Button8.Click        On Error GoTo handle01        Call 启动CAD()        Dim basePnt As Object        AcadApp.ActiveDocument.U

90、tility.GetEntity(returnObj, basePnt)        returnObj.highlight(True)        Call 获取2DPolyline节点坐标()        If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text

91、 <> 0 Then            Call CalculateCoordinate()        End If        Dim i As Integer        Dim s As String = &q

92、uot;"        For i = 0 To Count            s = s + xx(i).ToString() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)        

93、Next        RichTextBox1.Text = s        Button3.Enabled = True        AppActivate(Me.Text)        Exit Subhandle01:    

94、    MsgBox(Err.Description)    End Sub    Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click        Call 启动CAD()     &

95、#160;  Dim basePnt As Object        basePnt = AcadApp.ActiveDocument.Utility.GetPoint()        MsgBox("当前点击坐标位置为：" + basePnt(0).ToString() + "，" + basePnt(1).ToString()   

96、0;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

97、 As New OpenFileDialog        dg.Filter = "CAD files (*.dwg)|*.dwg|All files (*.*)|*.*"        dg.ShowDialog()        Dim s As String = dg.FileName    

98、;    If s = "" Then Exit Sub        启动CAD()        AcadApp.Application.Documents.Open(s)        AcadApp.ActiveDocument.WindowState = AutoCAD.AcWindowS

99、tate.acMax        AppActivate(Me.Text)        Button1.Enabled = True        Exit Subhandle01:        MsgBox(Err.Description)  

100、0; 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        

101、AcadApp.ActiveDocument.Save()        Exit SubHandle01:        MsgBox(Err.Description)    End Sub获取CAD中线的每个节点坐标程序设计（二） Private Sub 保存坐标数据文件SToolStripMenuItem_Click(ByVal sender As System.Object, B

102、yVal e As System.EventArgs) Handles 保存坐标数据文件SToolStripMenuItem.Click         On Error GoTo handle01         Dim dg As New SaveFileDialog         dg.Filter = "txt files (*.txt)

103、|*.txt|dat files (*.dat)|*.dat"         dg.ShowDialog()         Dim s As String = dg.FileName         Dim i As Integer         Dim s1 A

104、s String = ""         Using sw As StreamWriter = New StreamWriter(s)             For i = 0 To Count                

105、 s1 = xx(i).ToString() + "," + yy(i).ToString() + "," + zz(i).ToString()                 sw.WriteLine(s1)             Next   

106、          sw.Close()         End Using         Exit Sub handle01:         MsgBox(Err.Description)     End Sub&

107、#160;   Private Sub 刷新CAD图形RToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 刷新CAD图形RToolStripMenuItem.Click         On Error GoTo Handle01         AcadApp.Active

108、Document.Regen(AutoCAD.AcRegenType.acActiveViewport)         Exit Sub Handle01:         MsgBox(Err.Description)     End Sub     Private Sub 退出EToolStripMenuItem1_Click(ByVal sender

109、 As System.Object, ByVal e As System.EventArgs) Handles 退出EToolStripMenuItem1.Click         On Error GoTo Handle01         Application.Exit()         Exit Sub Handle01:   

110、;      MsgBox(Err.Description)     End Sub     Private Sub 获取线条上节点坐标LToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 获取线条上节点坐标LToolStripMenuItem1.Click      

111、60;  On Error GoTo handle01         Call 启动CAD()         Dim basePnt As Object         AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)    

112、0;    returnObj.highlight(True)         '判断线的类型         Dim LineTypenName As String         LineTypenName = returnObj.ObjectName.ToString()   

113、0;     If LineTypenName = "AcDbLine" Then             Call 获取line线节点坐标()         ElseIf LineTypenName = "AcDbSpline" Then      

114、60;      Call 获取Spline线拟合点坐标()         ElseIf LineTypenName = "AcDbPolyline" Then             Call 获取样条线节点坐标()         E

115、lse : Exit Sub         End If         If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then             Call CalculateCoordin

116、ate()         End If         Dim i As Integer         Dim s As String = ""         For i = 0 To Count     

117、0;       s = s + xx(i).ToString() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13)         Next         RichTextBox1.Text = s     

118、0;   Button3.Enabled = True         AppActivate(Me.Text)         Exit Sub handle01:         MsgBox(Err.Description)     End Sub    

119、; Private Sub tility.GetEntity(returnObj, basePnt)         returnObj.highlight(True)         '判断线的类型         Dim LineTypenName As String      

120、0;  LineTypenName = returnObj.ObjectName.ToString()         If LineTypenName = "AcDbPolyline" Then             Call 获取样条线节点坐标()         Else

121、 : Exit Sub         End If         If TextBox1.Text <> 0 Or TextBox2.Text <> 0 Or TextBox4.Text <> 0 Then             Call CalculateCoordinate

122、()         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)