装配中零件分类发包

934561127

[color=rgba(0, 0, 0, 0.78)]遍历装配体中的所有零件，提取符合条件的零件种类为"方件"或"圆件"的零件，并将其另存为指定文件夹中，求大神帮改下遍历零件获取属性这个代码
[color=rgba(0, 0, 0, 0.78)]

Sub ExtractParts()    Dim swApp As SldWorks.SldWorks    Dim swModel As SldWorks.ModelDoc2    Dim swAssy As SldWorks.AssemblyDoc    Dim swComp As SldWorks.Component2    Dim saveFolder As String    Dim compName As String    Dim compCategory As String        ' 设置SolidWorks应用程序对象    Set swApp = Application.SldWorks        ' 获取当前打开的装配体    Set swModel = swApp.ActiveDoc    If Not swModel.GetType = swDocASSEMBLY Then        MsgBox "请打开一个装配体！", vbExclamation        Exit Sub    End If    Set swAssy = swModel        ' 指定要保存零件的文件夹路径    saveFolder = "C:\Temp"        ' 遍历所有零件    For Each swComp In swAssy.GetComponents(False)        compName = swComp.Name        compCategory = GetPartCategory(compName)                ' 如果零件种类为"方件"或"圆件"，则另存为        If compCategory = "方件" Or compCategory = "圆件" Then            swComp.SaveAs saveFolder & "\" & swComp.Name        End If    Next swComp        MsgBox "提取并保存零件完成！", vbInformationEnd SubFunction GetPartCategory(partName As String) As String    ' 根据零件名称获取零件种类，这里可以根据实际情况编写判断逻辑    ' 假设这里简单地根据零件名称包含关键字来确定零件种类    If InStr(partName, "方件") > 0 Then        GetPartCategory = "方件"    ElseIf InStr(partName, "圆件") > 0 Then        GetPartCategory = "圆件"    Else        GetPartCategory = "其他"    End IfEnd Function
希望大神改下毕重谢！

cafe123

楼主发的有点乱啊

沉默的人

很不错，顶一下！

tommyshy

活到老学到老！