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
resolve a doi name
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 '取

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。