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 翻页-->
分享到:
相关推荐
提取CAD坐标至Excel 提取CAD坐标至Excel 提取CAD坐标至Excel
中线逐桩坐标计算原理很好用的看一下你就会了解的。
中线CAD使用步骤
cad编辑时经常遇到线不共面的情况,该小程序可以轻松解决cad中线不共面问题
中线CAD基础操作流程.pdf
CAD二次开发的插件,可以生成平行线的中线,可以辅助建立PKPM模型。
汽车线束设计软件及中线CAD应用简介.pdf
齿轮传动CAD开发中线图程序化处理方法.pdf
ArcGIS中导出线的坐标值,将shp文件的坐标点导出来
汽车线束行业软件,唯一获得国家发明专利的软件。可以快速计算线长,导出各种工艺数据和1:1工装板。
汽车线束设计软件及中线CAD应用简介 (1).pdf
中线逐桩坐标计算原理PPT学习教案.pptx
在程序中即为输入已知数据,程序中要把数据赋给相应的变量!我们这时需要设置数组!数组的设置要根据需要来设置,由于我们进行的是坐标计算,坐标是两个值,所以我们在程序中把坐标设为二维数组。
系统提供了“世界坐标系→大地坐标系”、“大地坐标系→世界坐标系”间的转换,系统支持整座互通N个匝道的绘图及AutoCad输出。 6、本系统使现场施工放样的计算工作变的简单、方便,同时也使公路互通匝道复杂曲线的...
CAD学习全套,制图更容易,工程制图教程附加软件,简易专业。
偏中线标定工作是矿山测量的一项日常性工作,中线执行便是偏中线工作的内业解算成果。本文解释了中线执行的含义,并提出了几种解算中线执行的方法。
高速公路测量中线放样过程及方法,介绍了高速公路测量的几种常用的方法。
1、可采用交点法和线元法参数来描述和定义道路设计中线对象,从而方便批量的进行中边桩坐标正反算、边桩坐标、桥梁桩基坐标计算,其中坐标反算桩号功能十分独特,一般软件反算仅能计算与路线垂直的桩号和边距,本...
autocad的二次开开通过autolisp开发的中心线程序