solidworks模型自定义属性的批量处理的宏代码

solidworks模型自定义属性的批量处理的宏代码 Attribute VB_Name = "利用子件处理属性1" '利用子件进行自定义属性的批量处理的VBA代码 '比较完善的第一版完成时间2012.11.05，作者:张中锋 '适用于深圳东风有限公司solidworks老模型属性更改满足金蝶公司PLM系统要求实例 '测试通过环境:2012.11.05 windows XP SP3 ;solidworks 2010 SP02(32bit) ''''''''''''''''''''''''''''''''''''''''''''''''' '版本更新日志 '1.0 2012.10.29 ?对属性中，存在空白情况处理时数据异常进行修复;?对于已经存在的自定义属性值，保护其值不被处理 '已知的bug记录 Public swModel2 As SldWorks.ModelDoc2 Public PARTNAME_Value_temp As String Public MATERIAL_Value2_temp As String Public swApp As SldWorks.SldWorks Sub main() Dim swModel As SldWorks.ModelDoc2 Dim swModelDocExt As SldWorks.ModelDocExtension Dim swSelMgr As SldWorks.SelectionMgr Dim swBOMAnnotation As SldWorks.BomTableAnnotation Dim swBOMFeature As SldWorks.BomFeature Dim swBomTable As Variant Dim boolstatus As Boolean Dim BomType As Long Dim Configuration As String Dim TemplateName As String Dim i, j, n, k As Integer Dim swBOM_name As String Dim component As Component2 Dim value_temp As Integer Dim time_start As String Dim txt_path As String Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc txt_path = swModel.GetPathName() & " .csv" Open txt_path For Output Shared As #400 Print #400, "图样代号"; ","; "零件名称"; ","; "零件材料"; Chr(10); Configuration = swModel.GetActiveConfiguration().Name If swModel.GetType = 1 Then Set swModel2 = swApp.ActiveDoc Call Custominfo_change(Configuration) ElseIf swModel.GetType = 2 Then value_temp = swModel.ResolveAllLightWeightComponents(False) '轻化取消到还原状态 Dim Components As Variant Dim SingleComponent As Variant Dim swComponent As SldWorks.Component2 Components = swModel.GetComponents(False) '获取整个装配体的组成部件(零件或者装配体) For Each SingleComponent In Components '遍历 Set swComponent = SingleComponent If Not swComponent Is Nothing Then If swComponent.GetModelDoc() Is Nothing Then '判断子件对象模型是否存在;轻化状态下获取不到，为空 Debug.Print "没有通过" Else Dim x As Integer Do '此循环实现处理当前模型和子件属性 If Not swComponent Is Nothing And x < 99 Then '一个很原始的方法强制使用当前的模型 Set swModel2 = swModel x = 100 Else Set swModel2 = swComponent.GetModelDoc() '取得子件对象模型 x = 101 End If Call Custominfo_change(swModel2.GetActiveConfiguration().Name) Loop Until x = 101 End If Else Debug.Print " 不能获取到子件" End If Next Else MsgBox "不是零件或者装配体模型" End If swModel.Save '保存文件 Close #400 MsgBox "属性转换完毕" End Sub Private Function Custominfo_change(ByVal vConfigName As String) '处理模型的属性 Dim vConfigNameArr As Variant Dim vCustInfoNameArr As Variant Dim vCustInfoName As Variant Dim vCustInfoName2 As Variant Dim vCustInfoNameArr2 As Variant Dim vCustInfoName2_temp As String Dim vCustInfoName_temp As String Dim a() As String Dim b() As String Dim m, n As Integer vCustInfoNameArr = swModel2.GetCustomInfoNames2(vConfigName) vCustInfoNameArr2 = swModel2.GetCustomInfoNames m = 0 If Not IsEmpty(vCustInfoNameArr2) Then '取得自定义属性表的属性数据 For Each vCustInfoName2 In vCustInfoNameArr2 vCustInfoName2_temp = CStr(vCustInfoName2) If vCustInfoName2_temp = "" Then '处理属性表中的空白数据行 m = m - 1 ReDim Preserve a(1, m) Exit For End If vCustInfoName_temp_value2 = swModel2.CustomInfo(vCustInfoName2) ReDim Preserve a(1, m) a(0, m) = Trim(vCustInfoName2_temp) a(1, m) = Trim(vCustInfoName_temp_value2) m = m + 1 ReDim Preserve a(1, m) Next End If n = 0 If Not IsEmpty(vCustInfoNameArr) Then '取得配置特定属性表的属性数据 For Each vCustInfoName In vCustInfoNameArr vCustInfoName_temp = CStr(vCustInfoName) If vCustInfoName_temp = "" Then '处理属性表中的空白数据行 n = n - 1 ReDim Preserve b(1, n) Exit For End If vCustInfoName_temp_value = swModel2.CustomInfo2(vConfigName, vCustInfoName) ReDim Preserve b(1, n) b(0, n) = Trim(vCustInfoName_temp) b(1, n) = Trim(vCustInfoName_temp_value) n = n + 1 ReDim Preserve b(1, n) Next End If Dim s, t As Integer If m > 0 Then '当数组a中有数据时 For s = 0 To UBound(a, 2) '循环取出a中存储的每一条数据 If a(0, s) <> "" And a(1, s) <> "" Then '当数据有效时 Call OldCustominfo_Value(a(0, s), a(1, s), "PARTNAME") ElseIf a(0, s) = "" Then '当数据无效时(此情况只会是取得最后一条数据时) Exit For End If Next s If PARTNAME_Value_temp = "" Then '在a中没有获取到合适的数据 If n > 0 Then For t = 0 To UBound(b, 2) '循环取出b中存储的每一条数据 If b(0, t) <> "" And b(1, t) <> "" Then '当数据有效时 Call OldCustominfo_Value(b(0, t), b(1, t), "PARTNAME") ElseIf b(0, t) = "" Then '当数据无效时(此情况只会是取得最后一条数据时) Exit For End If Next t End If End If End If If m > 0 Then For s = 0 To UBound(a, 2) If a(0, s) <> "" And a(1, s) <> "" Then Call OldCustominfo_Value(a(0, s), a(1, s), "MATERIAL") ElseIf a(0, s) = "" Then Exit For End If Next s If MATERIAL_Value2_temp = "" Then If n > 0 Then For t = 0 To UBound(b, 2) If b(0, t) <> "" And b(1, t) <> "" Then Call OldCustominfo_Value(b(0, t), b(1, t), "MATERIAL") ElseIf b(0, t) = "" Then Exit For End If Next t End If End If End If Dim DRAWNO_value As String Dim PARTNAME_value As String Dim MATERIAL_value As String PARTNAME_value = Trim(PARTNAME_Value_temp) MATERIAL_value = Trim(MATERIAL_Value2_temp) '使用模型的绝对路径获取文件图号，比使用标题更安全 Dim DRAWNO_value1, DRAWNO_value2, DRAWNO_value13 As String Dim DRAWNO_value_N As Integer DRAWNO_value1 = swModel2.GetPathName DRAWNO_value2 = StrReverse(DRAWNO_value1) DRAWNO_value_N = InStr(1, DRAWNO_value2, "\") DRAWNO_value3 = Mid(DRAWNO_value2, 8, DRAWNO_value_N - 8) DRAWNO_value = StrReverse(DRAWNO_value3) If Not IsEmpty(vCustInfoNameArr2) Then For Each vCustInfoName2 In vCustInfoNameArr2 '删除自定义属性 bRet = swModel2.DeleteCustomInfo(vCustInfoName2) Next End If swModel2.AddCustomInfo3 "", "DRAWNO", swCustomInfoText, DRAWNO_value '写入图样代号DRAWNO swModel2.AddCustomInfo3 "", "PARTNAME", swCustomInfoText, PARTNAME_value '写入零件名称PARTNAME Call new_unit If Trim(Left(DRAWNO_value, 1)) <> "Q" And Trim(Left(DRAWNO_value, 2)) <> "GB" Then '检查 标准 excel标准偏差excel标准偏差函数exl标准差函数国标检验抽样标准表免费下载红头文件格式标准下载 件 swModel2.AddCustomInfo3 "", "MATERIAL", swCustomInfoText, MATERIAL_value '写入零件材料MATERIAL Call new_Material Weight_value = Show_mass(swModel2.GetPathName) '获取零件重量的数值 swModel2.AddCustomInfo3 "", "Weight", swCustomInfoText, Format(Weight_value, "0.0") '写入零件重量Weight,使用1位小数" swModel2.AddCustomInfo3 "", "SPEC", swCustomInfoText, " " swModel2.AddCustomInfo3 "", "REMARK", swCustomInfoText, " " End If Print #400, DRAWNO_value; ","; PARTNAME_value; ","; MATERIAL_value; Chr(10); PARTNAME_Value_temp = "" MATERIAL_Value2_temp = "" End Function Private Function new_unit() '更改单位 Dim boolstatus As Boolean boolstatus = swModel2.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitSystem, 0, swUnitSystem_e.swUnitSystem_Custom) boolstatus = swModel2.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0) boolstatus = swModel2.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False) boolstatus = swModel2.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0) boolstatus = swModel2.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False) boolstatus = swModel2.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropDecimalPlaces, 0, 1) boolstatus = swModel2.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms) End Function Private Function new_Material() '更改材质 Dim matDbs As Variant Dim swPart As Object Dim MaterialDatabase As String Dim MATERIAL_value_temp As String Dim reval As Boolean '判断当前的模型文件类型 If swModel2.GetType() = 1 Then 'swModel_filename_value 值为1时，打开零件模型 matDbs = swApp.GetMaterialDatabases Set swPart = swModel2 MaterialDatabase = matDbs(0) MATERIAL_value_temp = swPart.GetMaterialPropertyName2(Configuration_Name, MaterialDatabase) '获取模型树中的材质值 If MATERIAL_value_temp = "" Then '如果没有指定材质，材质默认为普通碳钢 reval = swModel2.SetMaterialPropertyName2(Configuration_Name, MaterialDatabase, "普通碳钢") swModel2.ClearSelection2 True End If End If End Function Private Function OldCustominfo_Value(ByVal temp11 As String, ByVal temp22 As String, ByVal temp23) As String '处理旧自定义属性及值 OldCustominfo_Value = "" If Trim(temp22) <> "" And Left(Trim(temp22), 1) <> Chr(34) Then If temp23 = "PARTNAME" Then '如果调用的参数为 PARTNAME，需要 处理的变量为 PARTNAME_value_temp，赋相关值 If temp11 = "PARTNAME" And Left(Trim(temp22), 1) <> "名" And Left(Trim(temp22), 1) <> "D" And Left(Trim(temp22), 1) <> "零" Then PARTNAME_Value_temp = Trim(temp22) OldCustominfo_Value = PARTNAME_Value_temp ElseIf temp11 = "图样名称" Or temp11 = "零件名称" Or temp11 = "名称" Then If Left(Trim(temp22), 1) <> "D" And Left(Trim(temp22), 1) <> "零" And Left(Trim(temp22), 1) <> "装" And Left(Trim(temp22), 1) <> "名" Then PARTNAME_Value_temp = Trim(temp22) OldCustominfo_Value = PARTNAME_Value_temp Else OldCustominfo_Value = "" End If Else OldCustominfo_Value = "" End If ElseIf temp23 = "MATERIAL" Then '如果调用的参数为 MATERIAL，要处理的变量为 MATERIAL_value_temp，赋相关值 If temp11 = "MATERIAL" And Left(Trim(temp22), 1) <> "材" And Left(Trim(temp22), 1) <> "D" And Left(Trim(temp22), 1) <> "零" Then MATERIAL_Value2_temp = Trim(temp22) OldCustominfo_Value = MATERIAL_Value2_temp ElseIf temp11 = "材料名称" Or temp11 = "零件材料" Or temp11 = "材料" Then temp33 = Left(Trim(temp22), 1) If temp33 = "钢" Or temp33 = "4" Or temp33 = "1" Or temp33 = "2" Or temp33 = "Q" Or temp33 = "总" Or temp33 = "部" Or temp33 = "橡" _ Or temp33 = "尼" Or temp33 = "组" Or temp33 = "圆" Or temp33 = "方" Or temp33 = "焊" Or temp33 = "装" Or temp33 = "合" Or temp33 = "高" _ Or temp33 = "角" Or temp33 = "扁" Or temp33 = "热" Or temp33 = "冷" Or temp33 = "外" Or temp33 = "分" Or temp23 = "有" Then MATERIAL_Value2_temp = value_G(Trim(temp22)) OldCustominfo_Value = MATERIAL_Value2_temp Else OldCustominfo_Value = "" End If Else OldCustominfo_Value = "" End If End If Else OldCustominfo_Value = "" End If End Function Private Function value_G(ByVal value_G_in As String) As String '处理零件材料的值中的国标号 Dim value_G_temp As String Dim value_G_out As String Dim G_nomber As Integer value_G_temp = Trim(value_G_in) '删除变量中开头和结尾的空白字符 G_nomber = InStr(value_G_temp, "G") '查找字符“G”的第一次出现的位置 If G_nomber > 1 Then '如果获得“G” value_G_out = Left(value_G_temp, G_nomber - 1) '获得字符“G”之前的字符串 If value_G_out = "" Then value_G = "" '返回一个空值，没有取得值" Else value_G = value_G_out End If Else '没有字符“G” value_G = value_G_temp End If End Function Private Function Show_mass(ByVal DRAWNO_value11 As String) As String '获取质量的数值 Dim DRAWNO_value12, DRAWNO_value113 As String Dim DRAWNO_value1_N As Integer DRAWNO_value12 = StrReverse(DRAWNO_value11) DRAWNO_value1_N = InStr(1, DRAWNO_value12, "\") DRAWNO_value13 = Mid(DRAWNO_value12, 1, DRAWNO_value1_N) DRAWNO_value1 = StrReverse(DRAWNO_value13) Show_mass = Chr(34) & "SW-Mass@" & DRAWNO_value1 + Chr(34) End Function