frm

这是一个管线采集资料时管孔占用情况整理记录的工具,它可以通过操作AUTOCAD图纸进行图纸信息的操作.

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frm共性信息 
   Caption         =   "PartShip 2.0.. - 部件信息处理"
   ClientHeight    =   7020
   ClientLeft      =   30
   ClientTop       =   330
   ClientWidth     =   9885
   Icon            =   "frm共性信息.dsx":0000
   MaxButton       =   0   'False
   OleObjectBlob   =   "frm共性信息.dsx":030A
   StartUpPosition =   1  '所有者中心
End
Attribute VB_Name = "frm共性信息"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''陈立晋20040701

Private Sub cbb对象类别信息_Change()
Select Case frm共性信息.cbb对象类别信息.Value
    Case "主干"
    frm共性信息.lbl对象名称.Caption = "主干名称"
    Case "配区"
    frm共性信息.lbl对象名称.Caption = "配区名称"
    Case "配线"
    frm共性信息.lbl对象名称.Caption = "配区名称"
    Case "管道"
    frm共性信息.lbl对象名称.Caption = "管道名称"
End Select
End Sub




Private Sub cbb文档编号_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim s对象名称 As String
s对象名称 = "xxxx"
If Me.cbb对象名称.Value <> "" Then s对象名称 = Me.cbb对象名称.Value
Select Case frm共性信息.cbb对象类别信息.Value
    Case "主干"
    frm共性信息.cbb文档编号.Value = "主干(" & s对象名称 & ")"
    Case "配区"
    frm共性信息.cbb文档编号.Value = "配区(" & s对象名称 & ")"
    Case "配线"
    frm共性信息.cbb文档编号.Value = "配区(" & s对象名称 & ")"
    Case "管道"
    frm共性信息.cbb文档编号.Value = "管道(" & s对象名称 & ")"
End Select

End Sub

Sub cmd地片示意图_Click()
'    Load ufm地片划分图
'    ufm地片划分图.Show
Dim Gdata, s当前目录 As String
s当前目录 = Trim(CurDir)

S网页文件名称 = "Explorer " & s当前目录 & "\Data\地片划分图.jpg"
RUNF = Shell(S网页文件名称, 1)
End Sub

Private Sub cmd扩展功能_Click()
If Me.cmd扩展功能.Caption = ">>" Then
    Me.Width = 10000
    Me.cmd扩展功能.Caption = "<<"
Else
    Me.Width = 7000
    Me.cmd扩展功能.Caption = ">>"
End If
End Sub

Private Sub cmd退出_Click()
Unload frm共性信息
End
End Sub

Private Sub cmd确定_Click()
Me.MousePointer = vbArrowHourglass
'If IsDate(frm共性信息.txt竣工日期.Text) = False _
    Or IsDate(frm共性信息.txt归档日期.Text) = False _
    Or IsDate(frm共性信息.txt归档日期.Text) = False _
Then MsgBox "日期型的信息必须使用正确的日期格式,例如:2001-2-18", vbInformation, "提示": Exit Sub
On Error Resume Next
If Me.cmd确定.Caption = "完成" Then Unload frm共性信息: Exit Sub
Dim s当前目录, s题图名称 As String
s当前目录 = Trim(CurDir)
s题图名称 = s当前目录 & "\Data\PDATAOUT.bmp"
Me.Img题图.Picture = LoadPicture(s题图名称)

'pPartsDCO ''

'Me.cmd确定.Caption = "完成"
'Unload frm共性信息
Me.MousePointer = 0
MsgBox "导出完成."
End Sub




Private Sub cmd应用_Click()
Call AcadToolbar.pAcadToolbar(Me.ckb默认作图板菜单)
End Sub

Private Sub UserForm_Deactivate()
End
End Sub

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

Call AcadToolbar.pAcadToolbar(Me.ckb默认作图板菜单)


'''''''''''''''''''''''''''''''
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    ' 将数据读入两个变量。
    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   '提示栏显示
'''''''''''''''''''''''''''''''''''''''''''''
End Sub


Private Sub tlb提示栏_Click()
Dim s命令字串 As String

'MsgBox Me.tlb提示栏.Value
If Me.tlb提示栏.Value = True Then
    s命令字串 = Trim(Me.txt命令栏.Text)
    Select Case s命令字串
        Case ":comlong"
            Me.tlb提示栏.Caption = "命令运行中..."
            'ps缆线形式长度
            Me.txt命令栏.Text = ":"
            Me.tlb提示栏.Caption = "完成"
            Me.tlb提示栏.Value = False
        Case Else
            Me.tlb提示栏.Caption = "???"
    End Select
Else
    Me.tlb提示栏.Caption = "就绪"
End If
End Sub