AutoBOM/VBA/ClassModules/ProductModelParser.cls

'=====================================================================
' 类名: ProductModelParser
' 功能: 解析产品型号并提取物料选择条件
' 作者: Auto-generated
' 日期: 2025-01-29
'=====================================================================

Option Explicit

Private pFullModel As String
Private pHeaderModel As String
Private pConditions As Object ' Dictionary
Private pErrorMessage As String

'=====================================================================
' 属性: FullModel - 完整产品型号
'=====================================================================
Public Property Get FullModel() As String
    FullModel = pFullModel
End Property

Public Property Let FullModel(value As String)
    pFullModel = value
End Property

'=====================================================================
' 属性: HeaderModel - 表头型号
'=====================================================================
Public Property Get HeaderModel() As String
    HeaderModel = pHeaderModel
End Property

'=====================================================================
' 属性: Conditions - 提取的条件字典
'=====================================================================
Public Property Get Conditions() As Object
    Set Conditions = pConditions
End Property

'=====================================================================
' 属性: ErrorMessage - 错误信息
'=====================================================================
Public Property Get ErrorMessage() As String
    ErrorMessage = pErrorMessage
End Property

'=====================================================================
' 方法: Class_Initialize
' 功能: 初始化类
'=====================================================================
Private Sub Class_Initialize()
    Set pConditions = CreateObject("Scripting.Dictionary")
    pErrorMessage = ""
End Sub

'=====================================================================
' 方法: Parse
' 功能: 解析产品型号
' 参数: modelString - 完整产品型号字符串
' 返回: Boolean - True表示解析成功,False表示失败
'=====================================================================
Public Function Parse(modelString As String) As Boolean
    On Error GoTo ErrorHandler

    pFullModel = Trim(modelString)
    pConditions.RemoveAll
    pErrorMessage = ""

    ' 提取表头部分(|之前的部分)
    Dim parts() As String
    parts = Split(pFullModel, "|")

    If UBound(parts) < 0 Then
        pErrorMessage = "型号格式错误:缺少表头部分"
        Parse = False
        Exit Function
    End If

    pHeaderModel = Trim(parts(0))

    ' 解析表头型号
    If Not ParseHeader() Then
        Parse = False
        Exit Function
    End If

    Parse = True
    Exit Function

ErrorHandler:
    pErrorMessage = "解析异常: " & Err.description
    Parse = False
End Function

'=====================================================================
' 方法: ParseHeader
' 功能: 解析表头型号结构
' 返回: Boolean - True表示解析成功
' 说明: 表头结构 [型号]-[公称外径].[安装形式].[壳体形式].[过程连接&接液材质].[量程范围].[仪表特性]
'=====================================================================
Private Function ParseHeader() As Boolean
    On Error GoTo ErrorHandler

    ' 分离型号和其余部分
    Dim dashParts() As String
    dashParts = Split(pHeaderModel, "-")

    If UBound(dashParts) < 1 Then
        pErrorMessage = "表头格式错误:缺少'-'分隔符"
        ParseHeader = False
        Exit Function
    End If

    ' 分离各个字段(用.分隔)
    Dim dotParts() As String
    dotParts = Split(dashParts(1), ".")

    ' 验证结构完整性:至少需要5个部分(公称外径、安装形式、壳体形式、过程连接、量程)
    If UBound(dotParts) < 4 Then
        pErrorMessage = "表头结构不完整:缺少必要字段"
        ParseHeader = False
        Exit Function
    End If

    ' 提取各个条件
    ' 安装形式 - 第2个位置(索引1)
    Dim azxs As String
    azxs = Trim(dotParts(1))
    pConditions.Add "azxs", azxs

    ' 表壳形式 - 第3个位置(索引2)
    Dim bkxs As String
    bkxs = Trim(dotParts(2))
    pConditions.Add "bkxs", bkxs

    ' 过程连接和接液材质 - 第4个位置(索引3)
    Dim connectionCode As String
    connectionCode = Trim(dotParts(3))

    Dim gclj As String
    Dim jycz As String
    If Not ExtractConnectionAndMaterial(connectionCode, gclj, jycz) Then
        ParseHeader = False
        Exit Function
    End If

    pConditions.Add "gclj", gclj
    pConditions.Add "jycz", jycz

    ' 量程范围 - 第5个位置(索引4)
    Dim lcfw As String
    lcfw = Trim(dotParts(4))
    pConditions.Add "lcfw", lcfw

    ParseHeader = True
    Exit Function

ErrorHandler:
    pErrorMessage = "解析表头异常: " & Err.description
    ParseHeader = False
End Function

'=====================================================================
' 方法: ExtractConnectionAndMaterial
' 功能: 从过程连接代码中提取过程连接和接液材质
' 参数: code - 过程连接代码(如M203)
'       outConnection - 输出:过程连接(如M20)
'       outMaterial - 输出:接液材质(如3)
' 返回: Boolean - True表示提取成功
' 说明: 材质代码为最后一位数字,其余为螺纹代码
'=====================================================================
Private Function ExtractConnectionAndMaterial(code As String, _
                                              ByRef outConnection As String, _
                                              ByRef outMaterial As String) As Boolean
    On Error GoTo ErrorHandler

    If Len(code) < 2 Then
        pErrorMessage = "过程连接代码格式错误:长度不足"
        ExtractConnectionAndMaterial = False
        Exit Function
    End If

    ' 材质代码是最后一位数字
    Dim lastChar As String
    lastChar = Right(code, 1)

    ' 验证最后一位是否为数字
    If Not IsNumeric(lastChar) Then
        pErrorMessage = "过程连接代码格式错误:最后一位不是数字"
        ExtractConnectionAndMaterial = False
        Exit Function
    End If

    outMaterial = lastChar
    outConnection = Left(code, Len(code) - 1)

    ExtractConnectionAndMaterial = True
    Exit Function

ErrorHandler:
    pErrorMessage = "提取过程连接和材质异常: " & Err.description
    ExtractConnectionAndMaterial = False
End Function

'=====================================================================
' 方法: GetConditionValue
' 功能: 获取指定条件的值
' 参数: conditionName - 条件名称
' 返回: String - 条件值,如果不存在返回空字符串
'=====================================================================
Public Function GetConditionValue(conditionName As String) As String
    If pConditions.Exists(conditionName) Then
        GetConditionValue = pConditions(conditionName)
    Else
        GetConditionValue = ""
    End If
End Function

'=====================================================================
' 方法: GetAllConditions
' 功能: 获取所有条件的描述文本
' 返回: String - 条件描述文本
'=====================================================================
Public Function GetAllConditions() As String
    Dim result As String
    Dim key As Variant

    result = ""
    For Each key In pConditions.Keys
        result = result & key & "=" & pConditions(key) & "; "
    Next key

    GetAllConditions = result
End Function