Files
AutoBOM/VBA/ClassModules/clsConditionExtractor.cls
Misaka_Company a1347017e3 docs: expand AutoBOM architecture and implementation details
Refine project overview to include specific business context (Blaidy Company) and the main workbook file. Restructure the architecture section into a layered object-oriented design (Data, Processing, Application layers) and define the responsibilities of core VBA classes.

Add new technical documentation sections covering:
- Model number format parsing structure
- Condition expression language syntax
- Category hierarchy logic and picking strategies
- Material matching pipeline flow

Include VBA code examples for key methods such as CollectAllMaterials and GetMaterialsByCategoryAndModel to illustrate recursive traversal and material retrieval logic. Clarify the structure of key Excel configuration sheets.
2026-01-20 13:42:03 +08:00

234 lines
7.4 KiB
OpenEdge ABL
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
' ========================================
' 类模块: clsConditionExtractor
' 用途: 从型号解析器中提取物料选择条件
' ========================================
Option Explicit
' ========================================
' 私有成员变量
' ========================================
Private m_Conditions As Object ' Dictionary: 变量名 -> 条件值
Private m_ExtractionRules As Object ' Dictionary: 提取规则配置
' ========================================
' 类初始化
' ========================================
Private Sub Class_Initialize()
Set m_Conditions = CreateObject("Scripting.Dictionary")
Set m_ExtractionRules = CreateObject("Scripting.Dictionary")
' 初始化提取规则
InitializeRules
End Sub
' ========================================
' InitializeRules 方法 (私有)
' 功能: 初始化条件提取规则
' 说明: 这里配置所有需要提取的条件及其提取方法
' ========================================
Private Sub InitializeRules()
' 规则格式: Dictionary(变量名) = Array(源字段, 提取方法)
' 规则1: 过程连接 (gclj)
' ConnectionCode
m_ExtractionRules("gclj") = Array("ConnectionCode", "RemoveLastDigit")
' 规则2: 接液材质 (jycz)
' ConnectionCode
m_ExtractionRules("jycz") = Array("ConnectionCode", "GetLastDigit")
' 规则3: 量程范围 (lcfw)
' RangeCode
m_ExtractionRules("lcfw") = Array("RangeCode", "Direct")
' 未来可以在这里添加更多提取规则...
' 例如:
' m_ExtractionRules("bplx") = Array("DialCode", "Direct") ' 表盘类型
End Sub
' ========================================
' ExtractConditions 方法
' 功能: 从型号解析器中提取所有条件
' 参数: parser - clsModelParser对象
' 返回: Dictionary对象包含所有提取的条件
' ========================================
Public Function ExtractConditions(parser As clsModelParser) As Object
'
Set m_Conditions = CreateObject("Scripting.Dictionary")
' 验证解析器有效性
If Not parser.IsValid Then
Set ExtractConditions = m_Conditions
Exit Function
End If
' 遍历所有提取规则
Dim varName As Variant
For Each varName In m_ExtractionRules.Keys
Dim ruleInfo As Variant
ruleInfo = m_ExtractionRules(varName)
Dim sourceField As String
Dim extractMethod As String
sourceField = ruleInfo(0)
extractMethod = ruleInfo(1)
' 提取条件值
Dim conditionValue As String
conditionValue = ExtractValue(parser, sourceField, extractMethod)
'
If conditionValue <> "" Then
m_Conditions(CStr(varName)) = conditionValue
End If
Next varName
Set ExtractConditions = m_Conditions
End Function
' ========================================
' ExtractValue 方法 (私有)
' 功能: 根据规则从解析器中提取单个值
' 参数:
' parser - clsModelParser对象
' sourceField - 源字段名称
' extractMethod - 提取方法名称
' 返回: 提取的条件值
' ========================================
Private Function ExtractValue(parser As clsModelParser, _
sourceField As String, _
extractMethod As String) As String
Dim sourceValue As String
'
Select Case sourceField
Case "ConnectionCode"
sourceValue = parser.ConnectionCode
Case "RangeCode"
sourceValue = parser.RangeCode
Case "ModelType"
sourceValue = parser.ModelType
Case "Diameter"
sourceValue = parser.Diameter
Case "InstallForm"
sourceValue = parser.InstallForm
Case "ShellForm"
sourceValue = parser.ShellForm
Case "Characteristics"
sourceValue = parser.Characteristics
Case Else
sourceValue = ""
End Select
'
Select Case extractMethod
Case "Direct"
' 使
ExtractValue = sourceValue
Case "RemoveLastDigit"
'
If Len(sourceValue) > 1 Then
ExtractValue = Left(sourceValue, Len(sourceValue) - 1)
Else
ExtractValue = sourceValue
End If
Case "GetLastDigit"
'
If Len(sourceValue) > 0 Then
ExtractValue = Right(sourceValue, 1)
Else
ExtractValue = ""
End If
Case "GetFirstChar"
'
If Len(sourceValue) > 0 Then
ExtractValue = Left(sourceValue, 1)
Else
ExtractValue = ""
End If
Case Else
'
ExtractValue = ""
End Select
End Function
' ========================================
' GetConditionValue 方法
' 功能: 获取单个条件值
' 参数: varName - 变量名
' 返回: 条件值,如果不存在返回空字符串
' ========================================
Public Function GetConditionValue(varName As String) As String
If m_Conditions.Exists(varName) Then
GetConditionValue = m_Conditions(varName)
Else
GetConditionValue = ""
End If
End Function
' ========================================
' AddCondition 方法
' 功能: 手动添加条件 (用于特殊情况)
' 参数:
' varName - 变量名
' value - 条件值
' ========================================
Public Sub AddCondition(varName As String, value As String)
m_Conditions(varName) = value
End Sub
' ========================================
' GetConditions 属性
' 功能: 获取所有条件的Dictionary对象
' ========================================
Public Property Get conditions() As Object
Set conditions = m_Conditions
End Property
' ========================================
' ToString 方法
' 功能: 返回条件的字符串表示 (用于调试)
' ========================================
Public Function ToString() As String
Dim result As String
result = "【提取的条件】" & vbCrLf
If m_Conditions.Count = 0 Then
result = result & " (无条件)" & vbCrLf
Else
Dim key As Variant
For Each key In m_Conditions.Keys
result = result & " " & key & " = " & m_Conditions(key) & vbCrLf
Next key
End If
ToString = result
End Function
' ========================================
' AddExtractionRule 方法
' 功能: 动态添加新的提取规则 (用于扩展)
' 参数:
' varName - 变量名
' sourceField - 源字段名称
' extractMethod - 提取方法名称
' : extractor.AddExtractionRule "bplx", "DialCode", "Direct"
' ========================================
Public Sub AddExtractionRule(varName As String, _
sourceField As String, _
extractMethod As String)
m_ExtractionRules(varName) = Array(sourceField, extractMethod)
End Sub
' ========================================
' GetExtractionRules 方法
' 功能: 获取当前所有提取规则 (用于调试)
' 返回: Dictionary对象
' ========================================
Public Function GetExtractionRules() As Object
Set GetExtractionRules = m_ExtractionRules
End Function