系列化零件=180709=增加配置处理

Sub 遍历配置()
    Dim swDim As SldWorks.Dimension
    清除_保留首行
    
    sw全名 = Cells(首行, 文件路径列) & Cells(首行, 文件名称列)
    Call sw初始化(sw全名)
    
    获取浮动列
    '先一次性获取所有配置尺寸值,再在后面列出==开始
    configNames = swModel.GetConfigurationNames
    Set 尺寸字典 = CreateObject("Scripting.Dictionary")
    For 列号 = 尺寸首列 To 尺寸末列
        尺寸名 = Cells(表头行, 列号)
        Set swDim = swModel.Parameter(尺寸名)
        If Not swDim Is Nothing Then
            Debug.Print "  " & swDim.FullName & " [" & swDim.Name & "]"
            尺寸值组 = swDim.GetValue3(swAllConfiguration, configNames)
            For i = 0 To UBound(尺寸值组)
                尺寸值 = 尺寸值组(i)
                pz = configNames(i)
                Set 尺寸字典(pz) = CreateObject("Scripting.Dictionary")
                尺寸字典(pz)(尺寸名) = 尺寸值
            Next
        End If
    Next 列号
    '先一次性获取所有配置尺寸值,再在后面列出==结束
    
    当前行 = 首行 + 1
    For Each pz In configNames
    If Not 含其中之一(pz, "FLAT|平板") Then
        Cells(当前行, 文件路径列).Select
        ActiveCell = pz
        '========读取属性开始
        Dim lRetVal As Long
        Dim ValOut As String
        Dim ResolvedValOut As String
        Dim wasResolved As Boolean
        Set config = swModel.GetConfigurationByName(pz)
        Set cusPropMgr = config.CustomPropertyManager
        
        For 列号 = 属性首列 To 属性末列
            Cells(当前行, 列号).Select
            属性名 = Cells(表头行, 列号)
            lRetVal = cusPropMgr.Get5(属性名, False, ValOut, ResolvedValOut, wasResolved)
            ActiveCell = ValOut
        Next 列号
        '========读取属性结束
        
        For 列号 = 尺寸首列 To 尺寸末列
            Cells(当前行, 列号).Select
            尺寸名 = Cells(表头行, 列号)
            尺寸值 = 尺寸字典(pz)(尺寸名)
            ActiveCell = IIf(尺寸值 = "", "", 尺寸值)
        Next 列号
        当前行 = 当前行 + 1
    End If
    Next pz

End Sub
模块50遍历配置
Sub 修改配置()
    获取浮动列
    sw全名 = Cells(首行, 文件路径列) & Cells(首行, 文件名称列)
    Call sw初始化(sw全名)
    
    For 当前行 = 首行 + 1 To 末行
        Cells(当前行, 文件路径列).Select
        If ActiveCell.Interior.ColorIndex = "-4142" Then
            pz = Cells(当前行, 文件路径列)
            Call 修改配置_单行(pz, 当前行)
        End If
    Next
End Sub


Sub 修改配置_单行(ByVal pz, ByVal 当前行)
    Set config = swModel.GetConfigurationByName(pz)
    Set cusPropMgr = config.CustomPropertyManager
    
    For 列号 = 属性首列 To 属性末列
        Cells(当前行, 列号).Select
        属性名 = Cells(表头行, 列号)
        属性值 = ActiveCell
        If 属性值 <> "" Then
            lRetVal = cusPropMgr.Add3(属性名, 30, 属性值, swCustomPropertyDeleteAndAdd)
            ActiveCell.Interior.ColorIndex = 10
        End If
    Next 列号
    
            
End Sub
模块51修改配置

原文地址:https://www.cnblogs.com/yiguxianyun/p/9603944.html