求助:装配体中一键选择已出工程图的所有零件

DFFDSGG114485

   经典图书

求助:装配体中一键选择已出工程图的所有零件，求哪位大神指教一二

xx123458xx

选择已出工程图零件.zip (15.46 KB, 下载次数: 77, 售价: 5 金币)

2023-11-4 12:39 上传

点击文件名下载附件

' 定义全局变量
Dim swApp As SldWorks.SldWorks ' SolidWorks应用程序对象
Dim swModel As SldWorks.ModelDoc2 ' 当前活动的文档
Dim SelectedComponents As Collection ' 用于存储选中的组件的集合

' 主入口函数
Sub main()
    ' 初始化选中的组件集合
    Set SelectedComponents = New Collection
    ' 获取SolidWorks应用程序对象
    Set swApp = Application.SldWorks
    ' 获取当前活动的文档
    Set swModel = swApp.ActiveDoc

    ' 检查是否打开了文档
    If Not swModel Is Nothing Then
        ' 检查文档是否是装配体
        If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
            ' 获取装配体中的所有组件
            Dim vComps As Variant
            vComps = swModel.GetComponents(True)
            ' 遍历并选择组件
            TraverseAndSelectComponents vComps
        Else
            MsgBox "请在装配图中运行该宏。"
        End If
    Else
        MsgBox "没有打开的文档。"
    End If
End Sub

' 递归遍历装配体中的组件，并选择有对应工程图的组件
Sub TraverseAndSelectComponents(ByRef vComps As Variant)
    ' 创建文件系统对象，用于检查文件是否存在
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 遍历组件列表
    For Each comp In vComps
        Dim swComp As SldWorks.Component2
        Set swComp = comp

        ' 获取组件的路径，并构建其对应的工程图路径
        Dim sPartPath As String
        Dim sDrawingPath As String
        sPartPath = swComp.GetPathName
        sDrawingPath = Left(sPartPath, Len(sPartPath) - Len(GetFileExtension(sPartPath)) - 1) & ".SLDDRW"

        ' 检查工程图文件是否存在
        If fso.FileExists(sDrawingPath) Then
            ' 获取组件的模型文档
            Dim swCompModel As SldWorks.ModelDoc2
            Set swCompModel = swComp.GetModelDoc2
            ' 仅选择类型为零件的组件
            If Not swCompModel Is Nothing And swCompModel.GetType = swDocumentTypes_e.swDocPART Then
                swComp.Select2 True, 0
                SelectedComponents.Add swComp
            End If
        End If

        ' 获取当前组件的子组件
        Dim vChildren As Variant
        vChildren = swComp.GetChildren
        ' 如果有子组件，递归地遍历它们
        If Not IsEmpty(vChildren) Then
            TraverseAndSelectComponents vChildren
        End If
    Next comp
End Sub


' 辅助函数，用于获取文件的扩展名
Function GetFileExtension(ByVal filePath As String) As String
    Dim fso As Object
    ' 创建文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 获取并返回文件扩展名
    GetFileExtension = fso.GetExtensionName(filePath)
    ' 销毁对象
    Set fso = Nothing
End Function

fanqiema

   经典图书

你用我发的那个宏,里面就有这个功能.你可以把它提取出来

DFFDSGG114485

到这就执行不了了

DFFDSGG114485

   经典案例图书

xx123458xx 发表于 2023-11-4 12:41
' 定义全局变量
Dim swApp As SldWorks.SldWorks ' SolidWorks应用程序对象
Dim swModel As SldWorks ...

在装配环境中运行报错了

随遇而安9528

下载下来看看，应该会有用！

xx123458xx

   经典案例图书

DFFDSGG114485 发表于 2023-11-8 21:46
在装配环境中运行报错了

我也不懂宏，这个是我下载的，我用着没什么问题的。