Files
AutoBOM/VBA/Modules/modModelParserTest.bas
Misaka_Company c9cf84ed4d fix: update modules to use new LoadData interface and fix completeness check logic
Changes:
1. Update all modules to use LoadData(wsPlatform) instead of LoadData(wsConfig, wsPlatform)
   - modModelParserExamples.bas: Update 7 example procedures
   - modBOMProcessor.bas: Update 4 procedures
   - modModelParserTest.bas: Update 2 test procedures

2. Fix completeness check logic in GetValidMaterialsByModel
   - Only check root categories to avoid duplicate checking of subcategories
   - Previously, all required categories (including subcategories) were checked,
     causing subcategories to be added to missing list multiple times
   - Now only checks categories with ParentCategoryName = ""
   - CheckCategoryCompleteness already recursively checks all subcategories

3. Improve completeness judgment logic for categories with subcategories
   - Method 1: Parent category has 1 matching material → Complete
   - Method 2: Parent category has 0 matching materials, but all subcategories are complete → Complete
   - Other cases → Incomplete

Impact:
- Fixes "category missing" errors in Example9_BatchProcessOrders_WithCheck
- Eliminates duplicate entries in missing categories list
- Properly handles category hierarchy where parent categories are satisfied through subcategories

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-01-29 12:38:50 +08:00

307 lines
9.5 KiB
QBasic
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.
' ========================================
' 模块: modModelParserTest
' 用途: 测试型号解析和物料匹配功能
' ========================================
Option Explicit
' ========================================
' 测试1: 型号解析器基础功能
' ========================================
Sub Test1_ModelParser()
Debug.Print String(80, "=")
Debug.Print "测试1: 型号解析器基础功能"
Debug.Print String(80, "=")
Dim parser As New clsModelParser
Dim modelStr As String
' 测试用例1: 完整型号
modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
Debug.Print "【测试用例1】完整型号"
Debug.Print "输入: " & modelStr
If parser.ParseModel(modelStr) Then
Debug.Print parser.ToString()
Debug.Print "? 解析成功"
Else
Debug.Print "? 解析失败: " & parser.ErrorMessage
End If
Debug.Print ""
' 测试用例2: 仅表头
modelStr = "YTHN-100.A0.532.M203.M16.Y3"
Debug.Print "【测试用例2】仅表头"
Debug.Print "输入: " & modelStr
If parser.ParseModel(modelStr) Then
Debug.Print " 螺纹代码: " & parser.GetThreadCode()
Debug.Print " 材质代码: " & parser.GetMaterialCode()
Debug.Print " 量程代码: " & parser.GetRangeCode()
Debug.Print "? 解析成功"
Else
Debug.Print "? 解析失败: " & parser.ErrorMessage
End If
Debug.Print String(80, "=")
Debug.Print ""
End Sub
' ========================================
' 测试2: 条件提取器
' ========================================
Sub Test2_ConditionExtractor()
Debug.Print String(80, "=")
Debug.Print "测试2: 条件提取器"
Debug.Print String(80, "=")
Dim parser As New clsModelParser
Dim extractor As New clsConditionExtractor
Dim modelStr As String
modelStr = "YTHN-100.A0.532.M203.M16.Y3"
Debug.Print "输入型号: " & modelStr
If parser.ParseModel(modelStr) Then
Dim conditions As Object
Set conditions = extractor.ExtractConditions(parser)
Debug.Print extractor.ToString()
' 验证提取结果
Debug.Print "【验证】"
Debug.Print " gclj = " & extractor.GetConditionValue("gclj") & _
IIf(extractor.GetConditionValue("gclj") = "M20", " ?", " ?")
Debug.Print " jycz = " & extractor.GetConditionValue("jycz") & _
IIf(extractor.GetConditionValue("jycz") = "3", " ?", " ?")
Debug.Print " lcfw = " & extractor.GetConditionValue("lcfw") & _
IIf(extractor.GetConditionValue("lcfw") = "M16", " ?", " ?")
Else
Debug.Print "? 型号解析失败"
End If
Debug.Print String(80, "=")
Debug.Print ""
End Sub
' ========================================
' 测试3: 条件匹配器
' ========================================
Sub Test3_ConditionMatcher()
Debug.Print String(80, "=")
Debug.Print "测试3: 条件匹配器"
Debug.Print String(80, "=")
Dim matcher As New clsConditionMatcher
Dim conditions As Object
Set conditions = CreateObject("Scripting.Dictionary")
conditions("gclj") = "M20"
conditions("jycz") = "3"
conditions("lcfw") = "M16"
Debug.Print "【测试条件】"
Debug.Print " gclj = M20"
Debug.Print " jycz = 3"
Debug.Print " lcfw = M16"
Debug.Print ""
' 测试用例
Dim testCases As Variant
testCases = Array( _
Array("", True, "空条件"), _
Array("lcfw=M16", True, "简单等于"), _
Array("lcfw=M17", False, "简单不匹配"), _
Array("lcfw=M16 AND gclj=M20", True, "AND 全真"), _
Array("lcfw=M16 AND gclj=M10", False, "AND 一假"), _
Array("lcfw=M16 OR lcfw=M17", True, "OR 一真"), _
Array("lcfw=M15 OR lcfw=M17", False, "OR 全假"), _
Array("gclj!=M10", True, "不等于 真"), _
Array("gclj!=M20", False, "不等于 假"), _
Array("lcfw=M02 AND gclj!=M20", False, "复合条件1"), _
Array("lcfw=M16 AND gclj!=M10", True, "复合条件2"), _
Array("gclj=M20 AND (lcfw=M16 OR lcfw=M17)", True, "括号优先级1"), _
Array("gclj=M20 AND (lcfw=M15 OR lcfw=M17)", False, "括号优先级2") _
)
Dim i As Long
Dim testCase As Variant
Dim expr As String
Dim expected As Boolean
Dim actual As Boolean
Dim description As String
Dim passCount As Long
Dim failCount As Long
passCount = 0
failCount = 0
Debug.Print "【测试用例】"
For i = LBound(testCases) To UBound(testCases)
testCase = testCases(i)
expr = testCase(0)
expected = testCase(1)
description = testCase(2)
actual = matcher.IsMatch(expr, conditions)
If actual = expected Then
Debug.Print " ? " & description & ": " & IIf(expr = "", "(空)", expr)
passCount = passCount + 1
Else
Debug.Print " ? " & description & ": " & expr
Debug.Print " 预期: " & expected & ", 实际: " & actual
failCount = failCount + 1
End If
Next i
Debug.Print ""
Debug.Print "【统计】"
Debug.Print " 通过: " & passCount
Debug.Print " 失败: " & failCount
Debug.Print String(80, "=")
Debug.Print ""
End Sub
' ========================================
' 测试4: 完整流程 - 根据型号获取物料
' ========================================
Sub Test4_GetMaterialsByModel()
Debug.Print String(80, "=")
Debug.Print "测试4: 根据型号获取物料(完整流程)"
Debug.Print String(80, "=")
' 加载BOM数据
Dim bomMgr As New clsBOMManager
Dim wsPlatform As Worksheet
On Error Resume Next
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
On Error GoTo 0
If wsPlatform Is Nothing Then
Debug.Print "? 错误: 找不到必需的工作表 [平台配置清单]"
Exit Sub
End If
' ⭐ 使用新接口
bomMgr.LoadData wsPlatform
Debug.Print "? BOM数据加载完成"
Debug.Print ""
' 测试型号
Dim modelStr As String
modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
' 获取"部件"类别的符合条件的物料
Dim materials As collection
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件")
Debug.Print ""
Debug.Print "【结果验证】"
If materials.Count = 1 Then
Dim mat As clsMaterialItem
Set mat = materials(1)
If mat.code = "01011019018" And mat.Name = "高压接头部件" Then
Debug.Print "? 测试通过!成功匹配到正确的物料"
Debug.Print " 代号: " & mat.code
Debug.Print " 名称: " & mat.Name
Debug.Print " 条件: " & mat.Condition
Else
Debug.Print "? 匹配到的物料不正确"
End If
Else
Debug.Print "? 匹配数量不正确预期1个实际" & materials.Count & "个"
End If
Debug.Print String(80, "=")
Debug.Print ""
End Sub
' ========================================
' 测试5: 获取所有类别的符合条件的物料
' ========================================
Sub Test5_GetAllMaterialsByModel()
Debug.Print String(80, "=")
Debug.Print "测试5: 获取所有类别的符合条件的物料"
Debug.Print String(80, "=")
' 加载BOM数据
Dim bomMgr As New clsBOMManager
Dim wsPlatform As Worksheet
On Error Resume Next
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
On Error GoTo 0
If wsPlatform Is Nothing Then
Debug.Print "? 错误: 找不到必需的工作表 [平台配置清单]"
Exit Sub
End If
' ⭐ 使用新接口
bomMgr.LoadData wsPlatform
' 测试型号
Dim modelStr As String
modelStr = "YTHN-100.A0.532.M203.M16.Y3"
' 获取所有类别的符合条件的物料
Dim materials As collection
Set materials = bomMgr.GetMaterialsByModel(modelStr)
Debug.Print ""
Debug.Print "【匹配结果汇总】"
Debug.Print " 共匹配 " & materials.Count & " 个物料"
Debug.Print String(80, "=")
Debug.Print ""
End Sub
' ========================================
' 运行所有测试
' ========================================
Sub RunAllTests()
Debug.Print vbCrLf & vbCrLf
Debug.Print "╔" & String(78, "═") & "╗"
Debug.Print "║" & Space(20) & "型号解析与物料匹配 - 完整测试套件" & Space(20) & "║"
Debug.Print "╚" & String(78, "═") & "╝"
Debug.Print ""
Test1_ModelParser
Test2_ConditionExtractor
Test3_ConditionMatcher
Test4_GetMaterialsByModel
Test5_GetAllMaterialsByModel
Debug.Print "╔" & String(78, "═") & "╗"
Debug.Print "║" & Space(30) & "所有测试完成" & Space(30) & "║"
Debug.Print "╚" & String(78, "═") & "╝"
End Sub
' ========================================
' 测试6: 条件提取规则展示
' ========================================
Sub Test6_ShowExtractionRules()
Debug.Print String(80, "=")
Debug.Print "测试6: 当前配置的条件提取规则"
Debug.Print String(80, "=")
Dim extractor As New clsConditionExtractor
Dim rules As Object
Set rules = extractor.GetExtractionRules()
Debug.Print "【提取规则配置】"
Dim key As Variant
For Each key In rules.Keys
Dim ruleInfo As Variant
ruleInfo = rules(key)
Debug.Print " 变量名: " & key
Debug.Print " 源字段: " & ruleInfo(0)
Debug.Print " 提取方法: " & ruleInfo(1)
Debug.Print ""
Next key
Debug.Print String(80, "=")
Debug.Print ""
End Sub