獲取CAD中線的每個(gè)節(jié)點(diǎn)坐標(biāo)程序設(shè)計(jì)

1、獲取CAD中線的每個(gè)節(jié)點(diǎn)坐標(biāo)程序設(shè)計(jì)（一） 獲取CAD中線的每個(gè)節(jié)點(diǎn)坐標(biāo)，線包括polyline、3D polyline、Spline等等！程序代碼如下：Imports SystemImports System.IOImports System.MathPublic Class 獲取CAD中點(diǎn)坐標(biāo)    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()   '節(jié)約系統(tǒng)內(nèi)存        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 啟動(dòng)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 獲取樣條線節(jié)點(diǎn)坐標(biāo)()        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線節(jié)點(diǎn)坐標(biāo)()        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線擬合點(diǎn)坐標(biāo)()     

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線節(jié)點(diǎn)坐標(biāo)()       

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節(jié)點(diǎn)坐標(biāo)()        '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 啟動(dòng)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線節(jié)點(diǎn)坐標(biāo)()        ElseIf LineTypenNa

31、me = "AcDbSpline" Then            Call 獲取Spline線節(jié)點(diǎn)坐標(biāo)()        ElseIf LineTypenName = "AcDbPolyline" Then            Call

32、 獲取樣條線節(jié)點(diǎn)坐標(biāo)()        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        啟動(dòng)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 '設(shè)置精度            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 批量獲取節(jié)點(diǎn)坐標(biāo)Button_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 批量獲取節(jié)點(diǎn)坐標(biāo)Button.Click        Static ExitNum As Integer        On Error GoTo handle01   

55、60;    Static SaveNum As Integer        Call 啟動(dòng)CAD()        Dim basePnt As Object        AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)  

56、;      returnObj.highlight(True)        AcadApp.ActiveDocument.SendCommand("選取下一條線!連續(xù)在空白地方點(diǎn)擊兩次將會(huì)自動(dòng)退出批量存儲(chǔ)狀態(tài)!" + vbCr)        '判斷線的類型       

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

58、線節(jié)點(diǎn)坐標(biāo)()        ElseIf LineTypenName = "AcDbSpline" Then            Call 獲取Spline線節(jié)點(diǎn)坐標(biāo)()        ElseIf LineTypenName = "AcDbPolyline" Then

59、60;           Call 獲取樣條線節(jié)點(diǎn)坐標(biāo)()        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 批量獲取節(jié)點(diǎn)坐標(biāo)Button_Click(sender, e)        Exit Subhandle01:        ExitNum = ExitNum + 1        If ExitNum = 2 Then       

65、0;    ExitNum = 0            Exit Sub        Else : Call 批量獲取節(jié)點(diǎn)坐標(biāo)Button_Click(sender, e)        End If    End Sub &

66、#160;  Private Sub 設(shè)置文件保存路徑Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 設(shè)置文件保存路徑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 啟動(dòng)CAD()        Dim sset As AutoCAD.AcadSele

69、ctionSet        sset = AcadApp.ActiveDocument.SelectionSets.Add("NewSelectionSet")        ' 提示用戶選擇對(duì)象        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 啟動(dòng)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 啟動(dòng)CAD()        Dim basePnt As Object        AcadApp.ActiveDocument.U

90、tility.GetEntity(returnObj, basePnt)        returnObj.highlight(True)        Call 獲取2DPolyline節(jié)點(diǎn)坐標(biāo)()        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 啟動(dòng)CAD()     &

95、#160;  Dim basePnt As Object        basePnt = AcadApp.ActiveDocument.Utility.GetPoint()        MsgBox("當(dāng)前點(diǎn)擊坐標(biāo)位置為：" + basePnt(0).ToString() + "，" + basePnt(1).ToString()   

96、0;End Sub    Private Sub 打開(kāi)CAD文件OToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 打開(kāi)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        啟動(dòng)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中線的每個(gè)節(jié)點(diǎn)坐標(biāo)程序設(shè)計(jì)（二） Private Sub 保存坐標(biāo)數(shù)據(jù)文件SToolStripMenuItem_Click(ByVal sender As System.Object, B

102、yVal e As System.EventArgs) Handles 保存坐標(biāo)數(shù)據(jù)文件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 獲取線條上節(jié)點(diǎn)坐標(biāo)LToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 獲取線條上節(jié)點(diǎn)坐標(biāo)LToolStripMenuItem1.Click      

111、60;  On Error GoTo handle01         Call 啟動(dòng)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線節(jié)點(diǎn)坐標(biāo)()         ElseIf LineTypenName = "AcDbSpline" Then      

114、60;      Call 獲取Spline線擬合點(diǎn)坐標(biāo)()         ElseIf LineTypenName = "AcDbPolyline" Then             Call 獲取樣條線節(jié)點(diǎn)坐標(biāo)()         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 獲取樣條線節(jié)點(diǎn)坐標(biāo)()         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)