我之前做过不少SolidWorks宏的开发，刚好碰到过和你一模一样的需求——复制装配体和零件到新位置后，宏要能正确找到新位置的零件并更新设计表。给你两个实用的解决方案：

SolidWorks本身支持相对路径引用，只要提前配置好，复制文件后它会自动在当前装配体的文件夹下寻找零件。

操作步骤： #

• 首先确保你的SolidWorks开启了相对路径功能：
  1. 打开SolidWorks，点击「工具」→「选项」→「系统选项」→「外部参考引用」
  2. 勾选「使用相对路径」并保存设置
• 如果要通过宏自动配置这个选项，可以加这段代码：

  Dim swApp As SldWorks.SldWorks
  Set swApp = Application.SldWorks
  
  ' 开启相对路径引用
  swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swExternalReferencesUseRelativePaths, True
  

注意事项： #

这个方案的前提是零件和装配体的相对位置和原始文件夹一致（比如原来都在同一个文件夹，复制后也放在新文件夹里）。如果复制后文件夹结构变了，可能还是需要用方案二。

如果需要更灵活的控制（比如复制后零件和装配体不在同一文件夹，或者要强制指向当前文件夹），可以用代码逐个替换零件的绝对路径为当前装配体所在的文件夹路径。

完整代码示例： #

Sub UpdatePartPathsAndDesignTables()
    Dim swApp As SldWorks.SldWorks
    Dim swAssy As SldWorks.AssemblyDoc
    Dim swComponent As SldWorks.Component2
    Dim assyPath As String
    Dim assyFolder As String
    Dim partFileName As String
    Dim newPartPath As String
    Dim swPart As SldWorks.PartDoc
    
    ' 获取SolidWorks应用和当前激活的装配体
    Set swApp = Application.SldWorks
    Set swAssy = swApp.ActiveDoc
    
    If swAssy Is Nothing Then
        MsgBox "请先打开一个装配体文件！", vbExclamation
        Exit Sub
    End If
    
    ' 获取装配体的完整路径和所在文件夹
    assyPath = swAssy.GetPathName()
    If assyPath = "" Then
        MsgBox "请先保存当前装配体！", vbExclamation
        Exit Sub
    End If
    assyFolder = Left(assyPath, InStrRev(assyPath, "\"))
    
    ' 遍历装配体中所有零部件（包括嵌套的子零件/子装配体）
    For Each swComponent In swAssy.GetComponents(True)
        ' 跳过虚拟零件和未加载的零件
        If Not swComponent.IsVirtual And swComponent.GetPathName() <> "" Then
            ' 提取零件的文件名（不带原始路径）
            partFileName = Right(swComponent.GetPathName(), Len(swComponent.GetPathName()) - InStrRev(swComponent.GetPathName(), "\"))
            ' 拼接新的路径：当前装配体文件夹 + 零件文件名
            newPartPath = assyFolder & partFileName
            
            ' 更新零部件的引用路径（False表示不立即加载，提升效率）
            If swComponent.SetPathName(newPartPath, False) Then
                Debug.Print "已更新路径: " & swComponent.Name2
            Else
                Debug.Print "路径更新失败: " & swComponent.Name2
            End If
        End If
    Next
    
    ' 强制重新加载所有零部件，确保新路径生效
    swAssy.ReloadAllComponents True
    
    ' 逐个打开零件并更新设计表
    For Each swComponent In swAssy.GetComponents(True)
        If Not swComponent.IsVirtual Then
            ' 激活并打开零件（True表示如果未加载则打开）
            Set swPart = swComponent.GetModelDoc2(True)
            If Not swPart Is Nothing Then
                ' 更新设计表（根据你的需求调整参数，True表示强制更新）
                swPart.UpdateDesignTable True
                Debug.Print "已更新设计表: " & swPart.GetPathName()
                
                ' 如果需要自动保存零件，取消下面的注释
                ' swPart.Save2 True
            End If
        End If
    Next
    
    MsgBox "零件路径更新和设计表更新完成！", vbInformation
End Sub

代码说明： #

1. 获取装配体文件夹：通过GetPathName()拿到装配体的完整路径，再用Left和InStrRev提取文件夹部分
2. 遍历零部件：GetComponents(True)会遍历所有层级的零部件，包括嵌套的子装配体里的零件
3. 替换路径：SetPathName方法可以修改零部件的引用路径，最后用ReloadAllComponents强制加载新路径的零件
4. 更新设计表：UpdateDesignTable方法会刷新零件的设计表，你可以根据实际需求调整参数

额外提示： #

• 如果复制后的零件文件名和原始零件不同，你需要修改partFileName的逻辑，比如通过零件的名称匹配而不是原始文件名
• 如果要处理子装配体里的零件，这段代码已经覆盖了，因为GetComponents(True)会遍历所有嵌套层级

内容的提问来源于stack exchange，提问作者user9551155