在部件环境下子零件和子子零件依据iProperty类别分类另存为STP指定路径

[442780782]

附件为：在部件环境下子零件依据iProperty类别分类另存为STP指定路径的代码。是否可将代码优化为：在部件环境下子零件和子子零件依据iProperty类别分类另存为STP指定路径。@pmhker 王老师 帮忙分析下，谢谢！

[王承之pmhker]

下面这段是两层遍历，如果有更多层可以参照嵌套。

'导出子零件为STP格式保存到工作空间STP文件夹中
    MsgBox("导出子零件为STP格式保存到工作空间STP文件夹中",,"ilogic")
'[ STP转换器设定
    Dim STP转换器 As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}") 
	Dim 转换环境 As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
	Dim 转换设置 As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap	
']
' 获取当前正在编辑的部件文档对象
	Dim 总装 As AssemblyDocument = ThisApplication.ActiveDocument
	
' 获取当前部件文档所在的项目文件路径
    Dim 工作路径 As String = ThisDoc.WorkspacePath()   

'判断当前文档是否为装配	
    If 总装.DocumentType <> kAssemblyDocumentObject Then
        MsgBox ("请在装配环境下运行本插件。",,"iLogic")
        Exit Sub
    End If

'设置STP转换参数	
	If STP转换器.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, 转换环境, 转换设置) Then
    				转换设置.Value("ApplicationProtocolType") = 3
					转换环境.Type = IOMechanismEnum.kFileBrowseIOMechanism
   					 Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
				 
' 遍历所有子部件对象				 
            Dim 零部件对象 As ComponentOccurrence
                For Each 零部件对象 In 总装.ComponentDefinition.Occurrences
                    Dim 子零部件 = 零部件对象.Definition.Document
                    If 子零部件.DocumentType = kAssemblyDocumentObject Then
                        '遍历子部件对象
                        'msgbox("发现子部件",,"ilogic")     	 
                        Dim 子零部件对象 As ComponentOccurrence
                            For Each 子零部件对象 In 子零部件.ComponentDefinition.Occurrences
                                Dim 二级零部件 = 子零部件对象.Definition.Document
                                ' 获取零件属性字符串值		 
                                Dim 类别 = 二级零部件.PropertySets.Item("Inventor Document Summary Information").Item("Category").Value
                                Dim 代号 = 二级零部件.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
                                Dim 描述 = 二级零部件.PropertySets.Item("Design Tracking Properties").Item("Description").Value
                                    If 类别 = "机加件" Or 类别 = "钣金件" Or 类别 = "铝型材&亚克力" Then
                                        '构建文件名           
                                        Dim 文件名 = 工作路径 & "\STP\" & 类别 & "\" & 代号 & "-" & 描述 & ".stp"          
                                        oData.FileName = 文件名 
                                        STP转换器.SaveCopyAs(二级零部件, 转换环境, 转换设置, oData)
                                    end if
                            Next	
                    Else
                        ' 获取零件属性字符串值		 
                        Dim 类别 = 子零部件.PropertySets.Item("Inventor Document Summary Information").Item("Category").Value
                        Dim 代号 = 子零部件.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
                        Dim 描述 = 子零部件.PropertySets.Item("Design Tracking Properties").Item("Description").Value
                            If 类别 = "机加件" Or 类别 = "钣金件" Or 类别 = "铝型材&亚克力" Then
                                '构建文件名           
                                 Dim 文件名 = 工作路径 & "\STP\" & 类别 & "\" & 代号 & "-" & 描述 & ".stp"       
                                oData.FileName = 文件名
                                STP转换器.SaveCopyAs(子零部件, 转换环境, 转换设置, oData)
                            end if
                    End If

                Next 
            fdopen = MessageBox.Show("已在 " & 工作路径 & "\STP 中创建STP文件,是否打开文件夹？", "文件创建成功", MessageBoxButtons.YesNo)			
                If fdopen = vbYes Then
                    Shell("explorer.exe " & 工作路径 & "\STP", vbNormalFocus)
                End If
	End If
	
	
	

[442780782]

感谢！是否可采用BOM表单里的“仅零件”这项来判断

[王承之pmhker]

理论上说应该是可以的，实际上可能也没问题。有空时候我看看

[王承之pmhker]

试试下面这个规则

'[STP转换器配置
Dim oSTEPTranslator As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
']

'[为部件,BOM表,表视图声明变量
Dim 本装配 As AssemblyDocument =ThisDoc.Document
Dim BOM表 As BOM = 本装配.ComponentDefinition.BOM
Dim bom视图 As BOMView
']

工作路径=ThisDoc.WorkspacePath()
'激活仅零件视图
BOM表.PartsOnlyViewEnabled = True
'为BOM表行声明一个变量
Dim bom表行 As BOMRow
'为零件声明变量
Dim 零件定义 As PartComponentDefinition
Dim 零件 As PartDocument

'[检查视图
For Each bom视图 In BOM表.BOMViews
	If bom视图.ViewType = kpartsonlybomviewtype Then
		Exit For
	End If
Next
If bom视图 Is Nothing Then
	MsgBox("获取仅零件视图出错", , "ilogic")
	Exit Sub
End If
']

'[遍历导出表内零件
For Each bom表行 In bom视图.bomrows
	零件定义 = bom表行.ComponentDefinitions(1)
	零件 = 零件定义.Document
	零件代号 = 零件.propertysets.item("Design Tracking Properties").item("Part Number").value
	描述 = 零件.propertysets.item("Design Tracking Properties").item("Description").value
	类别=零件.propertysets.item("Inventor Document Summary Information").item("Category").value
	If 类别 = "机加件" Or 类别 = "钣金件" Or 类别 = "冲压件" Then
		Dim 新文件 = 工作路径 & "\STP\" & 类别 & "\" & 零件代号 & "-" & 描述 & ".stp"
		If oSTEPTranslator.HasSaveCopyAsOptions(ThisApplication.ActiveDocument, oContext, oOptions) Then
		    oOptions.Value("ApplicationProtocolType") = 3
		    oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
		    Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
		    oData.FileName = 新文件
			oSTEPTranslator.SaveCopyAs(零件, oContext, oOptions, oData)
		End If
		
	End If	
Next
']

打开路径 = MessageBox.Show("已在" & 工作路径 & "\STP\ 中创建STP文件，是否打开文件夹？", "导出成功", MessageBoxButtons.YesNo)
If 打开路径 = vbYes Then
	Shell("explorer.exe " & 工作路径 & "\STP", vbNormalFocus)
End If

[442780782]

王老师。测试代码，弹出如下报错窗口。

[王承之pmhker]

能传个文件上来分析吗？

[442780782]

王老师。麻烦测试。谢谢！

[王承之pmhker · Accepted solution]

BOM中把外购件装配合并为一项，导致上述代码出错，以下是修改后的代码

'[STP转换器配置
Dim oSTEPTranslator As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
']

'[为部件,BOM表,表视图声明变量
Dim 本装配 As AssemblyDocument =ThisDoc.Document
Dim BOM表 As BOM = 本装配.ComponentDefinition.BOM
Dim bom视图 As BOMView
']

工作路径=ThisDoc.WorkspacePath()
'激活仅零件视图
BOM表.PartsOnlyViewEnabled = True
'为BOM表行声明一个变量
Dim bom表行 As BOMRow
'为零件声明变量
Dim 零件定义
Dim 零件 As PartDocument

'[检查视图
For Each bom视图 In BOM表.BOMViews
	If bom视图.ViewType = kpartsonlybomviewtype Then
		Exit For
	End If
Next
If bom视图 Is Nothing Then
	MsgBox("获取仅零件视图出错", , "ilogic")
	Exit Sub
End If
']

'[遍历导出表内零件
For Each bom表行 In bom视图.BOMRows
	零件定义 = bom表行.ComponentDefinitions(1)
	零件 = 零件定义.Document
	零件代号 = 零件.propertysets.item("Design Tracking Properties").item("Part Number").value
	描述 = 零件.propertysets.item("Design Tracking Properties").item("Description").value
	类别=零件.propertysets.item("Inventor Document Summary Information").item("Category").value
	If 类别 = "机加件" Or 类别 = "钣金件" Or 类别 = "冲压件" Then
		Dim 新文件 = 工作路径 & "\STP\" & 类别 & "\" & 零件代号 & "-" & 描述 & ".stp"
		If oSTEPTranslator.HasSaveCopyAsOptions(零件, oContext, oOptions) Then
		    oOptions.Value("ApplicationProtocolType") = 3
		    oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
		    Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
		    oData.FileName = 新文件
			oSTEPTranslator.SaveCopyAs(零件, oContext, oOptions, oData)
		End If
		
	End If	
Next
']

打开路径 = MessageBox.Show("已在" & 工作路径 & "\STP\ 中创建STP文件，是否打开文件夹？", "导出成功", MessageBoxButtons.YesNo)
If 打开路径 = vbYes Then
	Shell("explorer.exe " & 工作路径 & "\STP", vbNormalFocus)
End If

[442780782]

感谢！