|
|
Sub zgcd()
Dim zb12 As String
Dim NN As Double
Dim pn As Variant
Dim pnt(0 To 2) As Double
Dim blockRefObj As AcadBlockReference
Dim blockRefObj1 As AcadBlockReference
Dim textObj As AcadText
Dim dh As String
Dim x As Double
Dim y As Double
Dim z As Double
Dim pcode As String
Dim ly As AcadLayer
'UserForm4.Show
Dim ZG, BL As String
Dim XA, XB As String
Dim SBD As String
''''''''''''''''''''''''''''''''''''''字高
NN = 10 ^ E
''''''''''''''''''''''''''''''''''''''''''''''''''
If TextBox3.text "500" And TextBox3.text "1000" And TextBox3.text "2000" Then
MsgBox "您输入比例尺有误，请重新输入比例尺！！！"
Exit Sub
End If
If TextBox3.text = "500" Then
ZG = "1.25"
End If
If TextBox3.text = "1000" Then
ZG = "2.5"
End If
If TextBox3.text = "2000" Then
ZG = "5"
End If
''''''''''''''''''''''''''''''''''''''比例
If TextBox3.text = "500" Then
BL = "0.5"
End If
If TextBox3.text = "1000" Then
BL = "1"
End If
If TextBox3.text = "2000" Then
BL = "2"
End If
Set ly = ThisDrawing.Layers.Add("点")
ly.Color = acRed
Set ly = ThisDrawing.Layers.Add("代码")
ly.Color = acRed
Set ly = ThisDrawing.Layers.Add("高程")
ly.Color = acGreen
Set ly = ThisDrawing.Layers.Add("点号")
ly.Color = acMagenta
Set ly = ThisDrawing.Layers.Add("GCD")
ly.Color = acGreen
Set ly = ThisDrawing.Layers.Add("yfh09")
ly.Color = acGreen
UserForm1.CommonDialog1.Filter = "All Files|*.*|*.dat|*.dat|"
UserForm1.CommonDialog1.FilterIndex = 2
UserForm1.CommonDialog1.DefaultExt = ".dat"
UserForm1.CommonDialog1.Action = 1
fl1 = UserForm1.CommonDialog1.FileName
If fl1 = "" Then Exit Sub
Open fl1 For Input As #1
Line Input #1, dh
I = InStr(1, dh, ",")
If I > 0 Then
Close #1
Open fl1 For Input As #1
End If
I = 0
Do While Not EOF(1)
On Error GoTo ex1
Input #1, dh, pcode, x, y, z
z = Fix((z * NN) + Sgn(z) * 0.00000000001) / NN
pnt(0) = x
pnt(1) = y
pnt(2) = z
SBD = "C:\YFH-MAP\SYM\SBD.dwg"
If pnt(0) * pnt(1) * pnt(2) 0 Then
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(pnt, SBD, BL, BL, 1#, 0)
blockRefObj.Layer = "GCD"
blockRefObj.Color = acByLayer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''在此处判断pcode的名称
如果pcode="st"
就在此处插入一个块"zb12"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''以下代码不好使'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If pcode = "st" Then
zb12 = "C:\YFH-MAP\SYM\zb12.dwg"
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(pnt, zb12, BL, BL, 1#, 0)
blockRefObj.Layer = "yfh09"
blockRefObj.Color = acByLayer
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''以上代码不好使'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
pnt(0) = pnt(0) + 1
Set textObj = ThisDrawing.ModelSpace.AddText(pnt(2), pnt, ZG)
textObj.Layer = "高程"
textObj.Color = acByLayer
pnt(0) = pnt(0) - 3.5
pnt(1) = pnt(1) + 0.5
Set textObj = ThisDrawing.ModelSpace.AddText(dh, pnt, 2.5)
textObj.Layer = "点号"
textObj.Color = acByLayer
'pnt(0) = pnt(0) - 1
pnt(1) = pnt(1) - 3.5
Set textObj = ThisDrawing.ModelSpace.AddText(pcode, pnt, 2.5)
textObj.Layer = "代码"
textObj.Color = acByLayer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
I = I + 1
End If
Loop
Close #1
ex1:
ThisDrawing.Application.ZoomExtents
End Sub
|
|
置顶卡
