获取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 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 <!--v:3.2-->

<!--E 文章--><!--S 翻页-->