需求概述 #

需要从CATIA产品结构中提取Bundle Segment的指定属性，并按以下表格格式输出到Excel：

分支信息表 #

Bundle Segment属性表 #

已知Bundle Segment属性窗口包含：类型为Bundle Segment、参考标识BNS0001、直径6.2mm、弯曲半径37.2mm、长度238.199mm；现有代码获取的参数名称带冗余路径（如E92X 78XXX 000 TX-BS001\Constraints\BNS0001\Diameter），需优化处理。

优化后的VBA代码 #

Sub GetBundleSegmentProperties(oCurrentProduct As Product)
    Dim oCurrentTreeNode As Product
    Dim MyCurrParentPN As String
    Dim LastRow As Long
    Dim oCurrentTreeNodePart As Part
    Dim objParameters As Parameters
    Dim objParameter As Parameter
    Dim strParmName As String, strParmValue As String
    Dim arrParmPath As Variant
    Dim simpleParmName As String
    Dim bnsID As String, diameter As String, bendRadius As String, length As String
    Dim dsName As String, partZone As String, branchName As String
    
    ' 假设WS是已定义的Excel工作表对象
    If WS Is Nothing Then Exit Sub
    
    ' 遍历当前产品的所有子节点
    For i = 1 To oCurrentProduct.Products.Count
        Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
        MyCurrParentPN = oCurrentTreeNode.PartNumber
        Application.StatusBar = MyCurrParentPN
        
        ' 识别Bundle Segment节点（通过PartNumber后缀判断）
        If Mid(MyCurrParentPN, 18, 4) = "-BS0" Then
            Set oCurrentTreeNodePart = oCurrentTreeNode.ReferenceProduct.Parent.Part
            Set objParameters = oCurrentTreeNodePart.Parameters
            
            ' 初始化属性变量
            bnsID = ""
            diameter = ""
            bendRadius = ""
            length = ""
            branchName = ""
            
            ' 遍历参数提取目标属性
            For j = 1 To objParameters.Count
                Set objParameter = objParameters.Item(j)
                strParmName = objParameter.Name
                strParmValue = objParameter.ValueAsString
                
                ' 拆分参数路径，提取简化后的属性名
                arrParmPath = Split(strParmName, "\")
                simpleParmName = arrParmPath(UBound(arrParmPath))
                
                ' 匹配目标属性
                Select Case True
                    Case simpleParmName Like "*Branchable*"
                        branchName = simpleParmName
                    Case simpleParmName = "BNS0001" ' 匹配参考标识
                        bnsID = simpleParmName
                    Case simpleParmName = "Diameter"
                        diameter = strParmValue
                    Case simpleParmName = "Bend Radius" ' 需与CATIA实际参数名匹配
                        bendRadius = strParmValue
                    Case simpleParmName = "Length"
                        length = strParmValue
                End Select
            Next j
            
            ' 填充DS名称和部件区域（根据实际数据源调整）
            dsName = WS.Cells(1, 1).Value
            partZone = MyCurrParentPN
            
            ' 写入分支信息表
            LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            WS.Cells(LastRow, 1) = dsName
            WS.Cells(LastRow, 2) = partZone
            WS.Cells(LastRow, 3) = branchName
            
            ' 写入Bundle Segment属性表（示例从第5列开始，可按需调整）
            LastRow = WS.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
            WS.Cells(LastRow, 5) = bnsID
            WS.Cells(LastRow, 6) = diameter
            WS.Cells(LastRow, 7) = bendRadius
            WS.Cells(LastRow, 8) = length
        End If
        
        ' 递归处理子节点
        If oCurrentTreeNode.Products.Count > 0 Then
            GetBundleSegmentProperties oCurrentTreeNode
        End If
    Next i
    
    Application.StatusBar = False
End Sub

关键优化点说明 #

1. 参数名称拆分：通过Split(strParmName, "\")拆分带路径的参数名，提取最后一段作为简化属性名，去除冗余路径前缀。
2. 属性精准匹配：使用Select Case针对性匹配目标属性，避免无效参数干扰。
3. 结构化输出：将分支信息和Bundle Segment属性分别按表格结构写入Excel，确保格式对齐。
4. 变量初始化：每次处理节点前清空属性变量，避免残留上一节点数据。

注意事项 #

• 需确保WS已正确指向目标Excel工作表（可在调用前定义，如Set WS = ThisWorkbook.Sheets("Sheet1")）。
• 参数名（如"Bend Radius"）需与CATIA中实际参数名称完全匹配，若有差异需调整匹配条件。
• DS名称和部件区域的数据源若与示例不同，需修改对应赋值逻辑。

内容的提问来源于stack exchange，提问作者Sidamallappa LIMBIKAI