系列化零件=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
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