请教!!在展的时候怎么判断代码插入块
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
帮帮忙!!!拜托了!!! "在展的时候怎么判断代码插入块?"甚么意思?先把你想实现的功能和现在遇到的问题大概说一下,别人才容易明白你碰到甚么问题啊! 不好意思!!没有表达好!!
展点文件及格式如下:
点号,代码,Y横坐标,X纵坐标,高程
1,ST,500000.000,300000.00,15.000
2,Z,500300.000,300500.00,15.000
3,ST,500800.000,300800.00,15.000
4,Z,501000.000,301000.00,15.000
我想在展点的时候,如果代码 = ST 就在这个坐标点上插入一个块
不知道你所谓的“不好使”是什么意思?
不过其中一条语句最好改成
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(pnt, zb12, BL, BL, BL, 0)
就是图块的XYZ比例最好设置成一样的。
页:
[1]