AutoBOM/VBA/ClassModules/ProductModelParser.cls

'=====================================================================
' 类名: ProductModelParser
' 功能: 解析产品型号并提取物料选择条件
'=====================================================================

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

    ' 仪表特性 - 第6个位置(索引5)及之后的所有部分
    ' 因为仪表特性中可能包含.分隔符(如N3.N2.Y3)，所以需要合并从索引5开始的所有部分
    Dim fjgn As String
    If UBound(dotParts) >= 5 Then
        Dim instrumentFeature As String
        Dim i As Long
        instrumentFeature = ""

        ' 合并从索引5开始的所有部分，用.连接
        For i = 5 To UBound(dotParts)
            If instrumentFeature = "" Then
                instrumentFeature = dotParts(i)
            Else
                instrumentFeature = instrumentFeature & "." & dotParts(i)
            End If
        Next i

        instrumentFeature = Trim(instrumentFeature)
        fjgn = ExtractAdditionalFeatures(instrumentFeature)
    Else
        ' 如果没有仪表特性字段，fjgn为空
        fjgn = ""
    End If
    pConditions.Add "fjgn", fjgn

    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

'=====================================================================
' 方法: ExtractAdditionalFeatures
' 功能: 从仪表特性中提取附加功能
' 参数: instrumentFeature - 仪表特性字符串(如"N2,N3.Y3"或"Y3")
' 返回: String - 附加功能字符串，多个功能用逗号分隔
' 说明:
'   1. 识别并去除充油类型(位于最后，格式为Y+一位数字)
'   2. 统一分隔符处理(将.替换为,)
'   3. 去除可能的后缀分隔符
'=====================================================================
Private Function ExtractAdditionalFeatures(instrumentFeature As String) As String
    On Error GoTo ErrorHandler

    Dim result As String
    result = Trim(instrumentFeature)

    ' 1. 检查是否以Y+数字结尾（充油类型）
    If Len(result) >= 2 Then
        Dim lastTwoChars As String
        lastTwoChars = Right(result, 2)

        ' 检查最后两位是否为Y+数字
        If UCase(Left(lastTwoChars, 1)) = "Y" And IsNumeric(Right(lastTwoChars, 1)) Then
            ' 去掉充油类型
            result = Left(result, Len(result) - 2)
            result = Trim(result)
        End If
    End If

    ' 2. 处理可能的分隔符（,或.）
    ' 将可能的.替换为,，统一处理
    result = Replace(result, ".", ",")

    ' 3. 去除可能的后缀分隔符
    If Len(result) > 0 And Right(result, 1) = "," Then
        result = Left(result, Len(result) - 1)
    End If

    ExtractAdditionalFeatures = Trim(result)
    Exit Function

ErrorHandler:
    ' 如果解析出错，返回空字符串
    ExtractAdditionalFeatures = ""
End Function