获取CAD中线的每个节点坐标程序设计.doc
23页
获取CAD中线的每个节点坐标，线包括polyline、3D polyline、Spline等等！程序代码如下：Imports SystemImports System.IOImports System.MathPublic 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 Nexthandle01: 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 Nexthandle01: 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() + "," + yy(i).ToString() + "," + zz(i).ToString() + Chr(13) Next RichTextBox1.Text = s Button3.Enabled = True AppActivate(Me.Text) Exit Subhandle01: 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 (*.*)|*.*"。
