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 |