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

获取CAD中线的每个节点坐标程序设计（一） 获取CAD中线的每个节点坐标，线包括polyline、3D polyline、Spline等等！程序代码如下：Imports SystemImports System.IOImports System.MathPublic Class 获取CAD中点坐标Public AcadApp As AutoCAD.AcadApplicationPublic xx(), yy(), zz() As DoublePublic Count As IntegerPublic returnObj As ObjectPublic FolderPath As String = C:/Public StepNum As Integer = 0Private Declare Auto Function SetProcessWorkingSetSize Lib kernel32.dll (ByVal procHandle As IntPtr, ByVal min As Int32, ByVal max As Int32) As BooleanPublic Sub SetProcessWorkingSetSize() 节约系统内存TryDim Mem As ProcessMem = Process.GetCurrentProcess()SetProcessWorkingSetSize(Mem.Handle, -1, -1)Catch ex As ExceptionMsgBox(ex.ToString)End TryEnd SubPublic Sub 启动CAD()On Error Resume NextAcadApp = GetObject(, AutoCAD.Application)If Err.Number ThenErr.Clear()AcadApp = CreateObject(AutoCAD.Application)End IfAcadApp.Visible = TrueAcadApp.WindowState = AutoCAD.AcWindowState.acMaxAppActivate(AcadApp.Caption)End SubPublic Sub 获取样条线节点坐标()Dim i As IntegerFor i = 0 To 10000 Step StepNumOn Error GoTo handle01Count = iReDim 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.elevationNexthandle01:Count = Count - 1End SubPublic Sub 获取Spline线节点坐标()Dim fitPoints As ObjectDim i As IntegerFor i = 0 To returnObj.NumberOfControlPoints - 1 Step StepNumfitPoints = returnObj.GetControlPoint(i)Count = iReDim Preserve xx(i)ReDim Preserve yy(i)ReDim Preserve zz(i)xx(i) = fitPoints(0)yy(i) = fitPoints(1)zz(i) = fitPoints(2)NextEnd SubPublic Sub 获取Spline线拟合点坐标()Dim fitPoints As ObjectDim pp As AutoCAD.AcadSplineDim i As IntegerFor i = 0 To returnObj.NumberOfFitPoints - 1 Step StepNumfitPoints = returnObj.GetFitPoint(i)Count = iReDim Preserve xx(i)ReDim Preserve yy(i)ReDim Preserve zz(i)xx(i) = fitPoints(0)yy(i) = fitPoints(1)zz(i) = fitPoints(2)NextEnd SubPublic Sub 获取line线节点坐标()Dim StartPoints As ObjectDim EndPoints As ObjectReDim Preserve xx(1)ReDim Preserve yy(1)ReDim Preserve zz(1)Count = 1returnObj.highlight(True)StartPoints = returnObj.StartPointEndPoints = returnObj.EndPointxx(0) = StartPoints(0)yy(0) = StartPoints(1)zz(0) = StartPoints(2)xx(1) = EndPoints(0)yy(1) = EndPoints(1)zz(1) = EndPoints(2)End SubPublic Sub 获取2DPolyline节点坐标()Dim sss As AutoCAD.AcadLWPolylinereturnObj.highlight(True)Dim i As IntegerFor i = 0 To 10000 Step StepNumOn Error GoTo handle01Count = iReDim 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.elevationNexthandle01:Count = Count - 1End SubPrivate Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickOn Error GoTo handle01Call 启动CAD()Dim basePnt As ObjectAcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)returnObj.highlight(True)判断线的类型Dim LineTypenName As StringLineTypenName = returnObj.ObjectName.ToString()If LineTypenName = AcDbLine ThenCall 获取line线节点坐标()ElseIf LineTypenName = AcDbSpline ThenCall 获取Spline线节点坐标()ElseIf LineTypenName = AcDbPolyline ThenCall 获取样条线节点坐标()Else : Exit SubEnd IfIf TextBox1.Text 0 Or TextBox2.Text 0 Or TextBox4.Text 0 ThenCall CalculateCoordinate()End IfDim i As IntegerDim s As String = For i = 0 To Counts = s + xx(i).ToString() + , + yy(i).ToString() + , + zz(i).ToString() + Chr(13)NextRichTextBox1.Text = sButton3.Enabled = TrueAppActivate(Me.Text)Exit Subhandle01:MsgBox(Err.Description)End SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.ClickOn Error GoTo handle01Dim dg As New OpenFileDialogdg.Filter = CAD files (*.dwg)|*.dwg|All files (*.*)|*.*dg.ShowDialog()Dim s As String = dg.FileNameIf s = Then Exit Sub启动CAD()AcadApp.Application.Documents.Open(s)AcadApp.ActiveDocument.WindowState = AutoCAD.AcWindowState.acMaxAppActivate(Me.Text)Button1.Enabled = TrueExit Subhandle01:MsgBox(Err.Description)End SubPrivate Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.ClickOn Error GoTo handle01Dim dg As New SaveFileDialogdg.Filter = txt files (*.txt)|*.txt|dat files (*.dat)|*.datdg.ShowDialog()Dim s As String = dg.FileNameDim i As IntegerDim s1 As String = Using sw As StreamWriter = New StreamWriter(s)For i = 0 To Counts1 = xx(i).ToString() + , + yy(i).ToString() + , + zz(i).ToString()sw.WriteLine(s1)Nextsw.Close()End UsingExit Subhandle01:MsgBox(Err.Description)End SubPrivate Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.ClickAcadApp.ActiveDocument.Regen(AutoCAD.AcRegenType.acActiveViewport)End SubPublic Sub CalculateCoordinate()On Error GoTo handle01Dim x0, y0, Rotangle As Doublex0 = TextBox1.Texty0 = TextBox2.TextRotangle = (TextBox4.Text) * 3.1415926 / 180Dim i As IntegerDim x1, y1 As DoubleIf Cos(Rotangle) = 0 ThenFor i = 0 To Countx1 = xx(i)xx(i) = yy(i) - y0yy(i) = x0 - x1NextExit SubEnd IfFor i = 0 To County1 = (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 = 0xx(i) = x1yy(i) = y1NextExit Subhandle01:MsgBox(Err.Description)End SubPrivate Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChangedEnd SubPrivate Sub 批量获取节点坐标Button_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 批量获取节点坐标Button.ClickStatic ExitNum As IntegerOn Error GoTo handle01Static SaveNum As IntegerCall 启动CAD()Dim basePnt As ObjectAcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)returnObj.highlight(True)AcadApp.ActiveDocument.SendCommand(选取下一条线!连续在空白地方点击两次将会自动退出批量存储状态! + vbCr)判断线的类型Dim LineTypenName As StringLineTypenName = returnObj.ObjectName.ToString()If LineTypenName = AcDbLine ThenCall 获取line线节点坐标()ElseIf LineTypenName = AcDbSpline ThenCall 获取Spline线节点坐标()ElseIf LineTypenName = AcDbPolyline ThenCall 获取样条线节点坐标()End IfIf TextBox1.Text 0 Or TextBox2.Text 0 Or TextBox4.Text 0 ThenCall CalculateCoordinate()End IfDim j As IntegerDim s1 As String = Using sw As StreamWriter = New StreamWriter(FolderPath + SaveNum.ToString() + .txt)For j = 0 To Counts1 = xx(j).ToString() + , + yy(j).ToString() + , + zz(j).ToString()sw.WriteLine(s1)Nextsw.Close()SaveNum = SaveNum + 1End UsingExitNum = 0Call 批量获取节点坐标Button_Click(sender, e)Exit Subhandle01:ExitNum = ExitNum + 1If ExitNum = 2 ThenExitNum = 0Exit SubElse : Call 批量获取节点坐标Button_Click(sender, e)End IfEnd SubPrivate Sub 设置文件保存路径Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 设置文件保存路径Button5.ClickDim fdg As FolderBrowserDialogfdg = New FolderBrowserDialogfdg.ShowDialog()If fdg.SelectedPath = Then Exit SubFolderPath = fdg.SelectedPathEnd SubPrivate Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.ClickOn Error GoTo Handle01Call 启动CAD()Dim sset As AutoCAD.AcadSelectionSetsset = AcadApp.ActiveDocument.SelectionSets.Add(NewSelectionSet) 提示用户选择对象sset.SelectOnScreen()Dim ent As ObjectDim sss As AutoCAD.AcadPointCount = -1For Each ent In ssetIf ent.Objectname = AcDbPoint ThenCount = Count + 1ReDim 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 IfNext entIf TextBox1.Text 0 Or TextBox2.Text 0 Or TextBox4.Text 0 ThenCall CalculateCoordinate()End IfDim i As IntegerDim s As String = For i = 0 To Counts = s + xx(i).ToString() + , + yy(i).ToString() + , + zz(i).ToString() + Chr(13)NextRichTextBox1.Text = sAcadApp.ActiveDocument.SelectionSets.Item(NewSelectionSet).Delete()AppActivate(Me.Text)Button3.Enabled = TrueExit SubHandle01:AcadApp.ActiveDocument.SelectionSets.Item(NewSelectionSet).Delete()Button5_Click(sender, e)MsgBox(Err.Description)End SubPrivate Sub Button6_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.ClickOn Error GoTo Handle01AcadApp.ActiveDocument.Save()Handle01:MsgBox(Err.Description)End SubPrivate Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.ClickCall 启动CAD()Dim basePnt As ObjectAcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)returnObj.highlight(True)AppActivate(AcadApp.Caption)Dim i As IntegerFor i = 0 To 500On Error GoTo handle01Count = iReDim 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)Nexthandle01:Count = Count - 1Dim j As IntegerDim s As String = For j = 0 To Counts = s + xx(j).ToString() + , + yy(j).ToString() + , + zz(j).ToString() + Chr(13)NextRichTextBox1.Text = sButton3.Enabled = TrueAppActivate(Me.Text)End SubPrivate Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.LoadCall SetProcessWorkingSetSize()End SubPrivate Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.ClickOn Error GoTo handle01Call 启动CAD()Dim basePnt As ObjectAcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)returnObj.highlight(True)Call 获取2DPolyline节点坐标()If TextBox1.Text 0 Or TextBox2.Text 0 Or TextBox4.Text 0 ThenCall CalculateCoordinate()End IfDim i As IntegerDim s As String = For i = 0 To Counts = s + xx(i).ToString() + , + yy(i).ToString() + , + zz(i).ToString() + Chr(13)NextRichTextBox1.Text = sButton3.Enabled = TrueAppActivate(Me.Text)Exit Subhandle01:MsgBox(Err.Description)End SubPrivate Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.ClickCall 启动CAD()Dim basePnt As ObjectbasePnt = AcadApp.ActiveDocument.Utility.GetPoint()MsgBox(当前点击坐标位置为： + basePnt(0).ToString() + ， + basePnt(1).ToString()End SubPrivate Sub 打开CAD文件OToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 打开CAD文件OToolStripMenuItem.ClickOn Error GoTo handle01Dim dg As New OpenFileDialogdg.Filter = CAD files (*.dwg)|*.dwg|All files (*.*)|*.*dg.ShowDialog()Dim s As String = dg.FileNameIf s = Then Exit Sub启动CAD()AcadApp.Application.Documents.Open(s)AcadApp.ActiveDocument.WindowState = AutoCAD.AcWindowState.acMaxAppActivate(Me.Text)Button1.Enabled = TrueExit Subhandle01:MsgBox(Err.Description)End SubPrivate Sub 保存CAD文件CToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 保存CAD文件CToolStripMenuItem.ClickOn Error GoTo Handle01AcadApp.ActiveDocument.Save()Exit SubHandle01: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() + , + yy(i).ToString() + , + zz(i).ToString() sw.WriteLine(s1) Next sw.Close() End Using Exit Sub handle01: MsgBox(Err.Description) End SubPrivate 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