'===================================================================== ' 类名: 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