myfreemind 发表于 2003-7-10 23:37:00

展点坐标程序原代码！

Option Explicit

Private Sub CommandButton1_Click()
Dim i As Integer
On Error Resume Next
Dim textline(5000) '行数据数组
Dim ds As Integer '总点数
Dim s As Integer '循环变量
Dim pnt(0 To 2) As Double '点位坐标
Dim tpnt(0 To 2) As Double '点名坐标
Dim pntobj As AcadPoint '点
Dim dm As AcadText '点名
'Dim us1 As String
Dim us2 As String '左下角X坐标
Dim us3 As String '左下角Y坐标
Dim ur5 As String '高程

i = 1 '初始值



CommonDialog1.ShowOpen
Open CommonDialog1.FileName For Input As #1
If CommonDialog1.FileName = "" Then Exit Sub
ProgressBar1.Visible = True
'Me.hide
Do While Not EOF(1)

Input #1, textline(i)
i = i + 1
Loop
Label1.Caption = i
Close #1

ds = textline(1) - 1

ProgressBar1.Min = 1
ProgressBar1.Max = ds



us2 = ThisDrawing.GetVariable("userr2") 'X坐标
us3 = ThisDrawing.GetVariable("userr3") 'Y坐标
ur5 = ThisDrawing.GetVariable("userr5") '高程

If ThisDrawing.GetVariable("useri5") <> 666 Then
ThisDrawing.SetVariable "useri5", 666
End If





For s = 0 To ds
ProgressBar1.Value = s
'点坐标





Select Case us1
Case 500
If us2 = 0 And us3 = 0 Then
pnt(0) = (textline(5 * s + 4)) * 2 + 100
pnt(1) = (textline(5 * s + 5)) * 2 + 100
pnt(2) = textline(5 * s + 6)

ElseIf us2 = 100 And us3 = 100 Then

pnt(0) = (textline(5 * s + 4)) * 2 - 100
pnt(1) = (textline(5 * s + 5)) * 2 - 100
pnt(2) = textline(5 * s + 6)
End If
Case 1000
If us2 = 0 And us3 = 0 Then
pnt(0) = textline(5 * s + 4) + 100
pnt(1) = textline(5 * s + 5) + 100
pnt(2) = textline(5 * s + 6)


ElseIf us2 = 100 And us3 = 100 Then

pnt(0) = textline(5 * s + 4)
pnt(1) = textline(5 * s + 5)
pnt(2) = textline(5 * s + 6)
End If
End Select







tpnt(0) = pnt(0) + 1
tpnt(1) = pnt(1)
tpnt(2) = 0
'创建点
Set pntobj = ThisDrawing.ModelSpace.AddPoint(pnt)
Set dm = ThisDrawing.ModelSpace.AddText(textline(5 * s + 2), tpnt, 2)

Next
Me.hide
ProgressBar1.Visible = False
MsgBox "展点完成"

ThisDrawing.Application.ZoomExtents






End Sub





Private Sub UserForm_Activate()
Label1.Visible = False
ProgressBar1.Visible = False

End Sub

lixy 发表于 2003-12-28 23:48:00

好

yfy2003 发表于 2003-12-29 09:08:00

建议将点和高程展到不同的图层！

myfreemind 发表于 2003-12-29 18:26:00

我上面那个程序没有展高程进去，只是在给点付了一个高程值，高程值我用另一个程序展，这样的话图面就不会太杂乱！

无痕 发表于 2004-1-15 02:09:00

我对“展点坐标”的感念不是很明确，请解释一下

yfy2003 发表于 2004-1-15 10:17:00

无痕发表于2004-1-15 2:09:00static/image/common/back.gif我对“展点坐标”的感念不是很明确，请解释一下


展点坐标在测绘中可重要了，全站仪在野外观测的数据不能展到CAD里就麻烦了！

ljcgq 发表于 2004-7-17 19:01:00

"展"是什么意思．．．具体的含义或者说事件是什么...有劳班主解释一下

洋葱老爹 发表于 2004-7-20 02:20:00

回:7楼


"展"是什么意思．．．具体的含义或者说事件是什么...有劳班主解释一下


展点:是测绘工作中的重要环结,以前进行的是模拟测量,用经纬仪等仪器在野外将特地形地物的特征点以方位角,距离的方式测量记录回来(外业),然后再"展"开一张空白图纸,将特征点按比例绘出,也象将压缩的点舒展开,这一步骤:边长/方位角---&gt;点坐标---&gt;上图       即展点.

monkey_w 发表于 2012-7-18 19:05:26

感谢楼主分享，继续学习中

comechris 发表于 2013-8-21 20:55:48

感谢分享，谢谢
页: [1] 2
查看完整版本: 展点坐标程序原代码！