feat: add core VBA source code modules
Add VBA directory with essential project code including: - ClassModules: BomExtractor, BomItem, ConditionEvaluator, ProductModelParser - Modules: MainModule, TestModule - Forms and DocumentModules - vba_metadata.json for module metadata Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka
234
VBA/ClassModules/ProductModelParser.cls
Normal file
234
VBA/ClassModules/ProductModelParser.cls
Normal file
@@ -0,0 +1,234 @@
|
||||
'=====================================================================
|
||||
' 类名: 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
|
||||
Reference in New Issue
Block a user