frm

来自「这是一个管线采集资料时管孔占用情况整理记录的工具,它可以通过操作AUTOCAD图」· 代码 · 共 233 行

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frm管孔布置器 
   Caption         =   "SIFANG - 管孔布置器"
   ClientHeight    =   6210
   ClientLeft      =   3900
   ClientTop       =   2565
   ClientWidth     =   7695
   Icon            =   "frm管孔布置.dsx":0000
   MaxButton       =   0   'False
   OleObjectBlob   =   "frm管孔布置.dsx":030A
End
Attribute VB_Name = "frm管孔布置器"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'''陈立晋20040816

Private Sub cbb对象类别信息_Change()
Select Case Me.cbb对象类别信息.Value
    Case "主干"
    Me.lbl对象名称.Caption = "主干名称"
    Case "配区"
    Me.lbl对象名称.Caption = "配区名称"
    Case "配线"
    Me.lbl对象名称.Caption = "配区名称"
    Case "光缆"
    Me.lbl对象名称.Caption = "光缆名称"
    Case "管道"
    Me.lbl对象名称.Caption = "管道名称"
    Case Else
    Me.lbl对象名称.Caption = "其它名称"
End Select
End Sub



Private Sub cbb人井名称_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.cbb人井名称.AddItem Me.cbb人井名称.Value
End Sub

Private Sub ckb新占用_Change()
If Me.ckb新占用.Value = False Then
    Me.ckb新占用.Caption = "已有占用 ×"
    XZ = MsgBox("是否清空本操作面板的各个栏目的信息?", vbYesNo)
    If XZ = vbYes Then
        Me.cbb站点信息.Value = ""
        Me.cbb对象类别信息.Value = ""
        Me.cbb对象名称.Value = ""
        Me.txt线缆程式.Text = ""
        Me.txt线序信息.Text = ""
    End If
End If

End Sub



Private Sub cmb井壁A_Click()
Me.txt井壁面.Text = "A"
End Sub
Private Sub cmb井壁B_Click()
Me.txt井壁面.Text = "B"
End Sub
Private Sub cmb井壁C_Click()
Me.txt井壁面.Text = "C"
End Sub
Private Sub cmb井壁D_Click()
Me.txt井壁面.Text = "C"
End Sub

Private Sub cmb应用_Click()
If Me.Mpage管孔布置.SelectedItem.Name = "Page管孔布放" Then m管孔布放.p管孔布放
If Me.Mpage管孔布置.SelectedItem.Name = "Page占孔情况" Then MsgBox "请正确操作.", vbInformation, myTitle
Me.txt起始序号.Text = "1"
End Sub


Private Sub cmb取消_Click()
Unload Me
End
End Sub

Private Sub cmd导出占用_Click()
Call p占孔情况("导出占用")
MsgBox " 完成导出占用 >>>>"
End Sub

Private Sub cmd导入占用_Click()
Call p占孔情况("导入占用")
MsgBox ">>>> 完成导入占用"
End Sub

Private Sub lbl井壁放大_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.lbl井壁放大.Caption = ""
Me.lbl井壁放大.Height = 90: Me.lbl井壁放大.Width = 100
For iRow = 1 To Val(Me.txt孔行数.Text)
    For iColumn = 1 To Val(Me.txt孔列数.Text)
        Me.lbl井壁放大.Caption = Me.lbl井壁放大.Caption & "○"
    Next iColumn
    Me.lbl井壁放大.Caption = Me.lbl井壁放大.Caption & vbCrLf
Next iRow
'Me.lbl井壁放大.AutoSize = True
End Sub

Private Sub lbl井壁放大_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.lbl井壁放大.Caption = "^◎^"
Me.lbl井壁放大.Height = 20: Me.lbl井壁放大.Width = 20
End Sub



Private Sub txt孔列数_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.txt孔列数.Text = Str(Val(Me.txt孔列数.Text) + 1)
Me.txt孔行数.Text = Me.txt孔列数.Text
End Sub

Private Sub txt孔行数_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.txt孔行数.Text = Str(Val(Me.txt孔行数.Text) + 1)
End Sub



Private Sub txt总孔数_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.txt总孔数.Text = Str(Val(Me.txt孔列数.Text) * Val(Me.txt孔行数.Text))
End Sub

Private Sub txt线序信息_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim s对象名称 As String
s对象名称 = "xxxx"
If Me.cbb对象名称.Value <> "" Then s对象名称 = Me.cbb对象名称.Value
Select Case Me.cbb对象类别信息.Value
    Case "主干"
    Me.txt线序信息.Value = "ZG" & txt线号 & "="
    Case "配区"
    Me.txt线序信息.Value = "PX" & txt线号 & "="
    Case "配线"
    Me.txt线序信息.Value = "PX" & txt线号 & "="
    Case "光缆"
    Me.txt线序信息.Value = "GL" & txt线号 & "="
    Case "管道"
    Me.txt线序信息.Value = "GD" & txt线号 & "="
    Case Else
    Me.txt线序信息.Value = "QT" & txt线号 & "="
End Select
End Sub


Private Sub UserForm_Initialize()
    
'On Error Resume Next   ' 改变错误处理的方式。
On Error GoTo Errorhandler


Me.txt孔外径.Text = "90"
Me.txt孔距.Text = "10"
''''''''''''''''''''
Dim Gdata, s当前目录 As String
s当前目录 = Trim(CurDir)
'MsgBox s当前目录

Open s当前目录 & "\Data\地片.txt" For Input As #1    ' 打开输入文件。
Do While Not EOF(1)    ' 循环至文件尾。
    Input #1, Gdata    ' 将数据读入两个变量。
    cbb地片信息.AddItem Gdata    ' 在立即窗口中显示数据。
Loop
Close #1    ' 关闭文件。

Open s当前目录 & "\Data\机楼.txt" For Input As #1    ' 打开输入文件。
Do While Not EOF(1)    ' 循环至文件尾。
    Input #1, Gdata    ' 将数据读入两个变量。
    cbb机楼信息.AddItem Gdata    ' 在立即窗口中显示数据。
Loop
Close #1    ' 关闭文件。

Open s当前目录 & "\Data\站点.txt" For Input As #1    ' 打开输入文件。
Do While Not EOF(1)    ' 循环至文件尾。
    Input #1, Gdata    ' 将数据读入两个变量。
    cbb站点信息.AddItem Gdata    ' 在立即窗口中显示数据。
Loop
Close #1    ' 关闭文件。

Open s当前目录 & "\Data\对象类别.txt" For Input As #1    ' 打开输入文件。
Do While Not EOF(1)    ' 循环至文件尾。
    Input #1, Gdata    ' 将数据读入两个变量。
    cbb对象类别信息.AddItem Gdata    ' 在立即窗口中显示数据。
Loop
Close #1    ' 关闭文件。

Open s当前目录 & "\Data\人井名称.txt" For Input As #1    ' 打开输入文件。
Do While Not EOF(1)    ' 循环至文件尾。
    Input #1, Gdata    ' 将数据读入两个变量。
    cbb人井名称.AddItem Gdata    ' 在立即窗口中显示数据。
Loop
Close #1    ' 关闭文件。

Open s当前目录 & "\Data\管孔程式.txt" For Input As #1    ' 打开输入文件。
Do While Not EOF(1)    ' 循环至文件尾。
    Input #1, Gdata    ' 将数据读入两个变量。
    Me.cbb管孔程式.AddItem Gdata    ' 在立即窗口中显示数据。
Loop
Me.cbb管孔程式.Text = "大管孔"
Close #1    ' 关闭文件。

Open s当前目录 & "\Data\配区.txt" For Input As #1    ' 打开输入文件。
Do While Not EOF(1)    ' 循环至文件尾。
    Input #1, Gdata    ' 将数据读入两个变量。
    cbb对象名称.AddItem Gdata    ' 在立即窗口中显示数据。
Loop
Close #1    ' 关闭文件。

Open s当前目录 & "\Data\建造人.txt" For Input As #1    ' 打开输入文件。
Do While Not EOF(1)    ' 循环至文件尾。
    Input #1, Gdata    ' 将数据读入两个变量。
    cbb建造人信息.AddItem Gdata    ' 在立即窗口中显示数据。
Loop
Close #1    ' 关闭文件。

Exit Sub
Errorhandler:
    Select Case Err
        Case 76
        msg = "设定数据不存在,或者'Data'子目录不存在!"
        Case Else
        msg = "请正确操作! 错误可能是=" & Err
    End Select
    MsgBox msg & ". 当前目录: " & s当前目录
    'Me.tlb提示栏.Caption = "-" & msg   '提示栏显示
    'Resume Next
'''''''''''''''''''''''''''''''''''''''''''''
End Sub