如何通过VBA激活CATIA装配体中的指定零件以进行修改

问题背景 #

现有CATIA装配体结构如下：

• 主产品
  • 子产品1（层级1）
    • 零件1
  • 子产品2（层级1）
    • 子产品3（层级2）
      • 零件2

需要激活零件1或零件2（非仅选中），以便在装配模式下对其进行修改（已知同一时间只能激活一个零件）。尝试使用partDocument.Activate方法未生效，代码如下：

Dim documents1 As documents
Set documents1 = CATIA.documents

Dim partDocument1 As PartDocument
Set partDocument1 = documents1.item("SampleBottomBlock_ref.CATPart")
partDocument1.Activate

需求是通过VBA实现零件激活，并基于激活状态执行后续选择操作（如下方处理外部参考的代码）：

Dim partDocument1 As PartDocument
    Set partDocument1 = partDoc
    
    Dim part1 As part
    Set part1 = partDocument1.part
    Dim selection1 As selection
    Set selection1 = partDocument1.selection
    selection1.Clear
    Dim hybridBodies1 As HybridBodies
    Set hybridBodies1 = part1.HybridBodies
    
    Dim hybridBody1 As HybridBody
    Set hybridBody1 = hybridBodies1.item("External References")
    
    Dim hybridShapes1 As HybridShapes
    Set hybridShapes1 = hybridBody1.HybridShapes
    
    Dim myDict As Object
    Set myDict = CreateObject("Scripting.Dictionary")
    
    For Each Shape In hybridShapes1
        If myDict.exists(Shape.name) Then
            selection1.Add Shape
        Else
            myDict.Add Shape.name, Shape.name
        End If
    Next
    
    For Each Shape In hybridBody1.HybridBodies
        If myDict.exists(Shape.name) Then
            selection1.Add Shape
        Else
            myDict.Add Shape.name, Shape.name
        End If
    Next
    
    selection1.Delete
    selection1.Clear
    part1.Update

解决方案 #

在CATIA装配环境中，直接激活零件文档（PartDocument.Activate）无法让零件处于装配内的可编辑激活状态，必须通过装配体的Product对象调用ActivateComponent方法来激活目标零件。

核心步骤 #

1. 获取当前激活的主装配体（Product）
2. 遍历装配结构找到目标零件对应的Product对象（装配中的零件以Product对象存在，IsComponent属性为True，ReferencedProduct指向零件文档）
3. 调用ActivateComponent方法激活该零件

代码实现 #

1. 激活目标零件的通用函数

Sub ActivatePartInAssembly(partName As String)
    Dim mainProduct As Product
    Set mainProduct = CATIA.ActiveDocument.Product
    
    ' 递归遍历装配结构找目标零件
    Dim targetComp As Product
    Set targetComp = FindComponentByName(mainProduct, partName)
    
    If Not targetComp Is Nothing Then
        ' 激活该零件
        mainProduct.ActivateComponent targetComp
        MsgBox "已激活零件：" & partName
    Else
        MsgBox "未找到零件：" & partName
    End If
End Sub

' 递归查找指定名称的零件组件
Function FindComponentByName(parentProd As Product, compName As String) As Product
    Dim childProd As Product
    For Each childProd In parentProd.Products
        ' 判断是否为目标零件
        If childProd.IsComponent And childProd.Name = compName Then
            Set FindComponentByName = childProd
            Exit Function
        End If
        ' 递归查找子装配
        Dim foundComp As Product
        Set foundComp = FindComponentByName(childProd, compName)
        If Not foundComp Is Nothing Then
            Set FindComponentByName = foundComp
            Exit Function
        End If
    Next
    Set FindComponentByName = Nothing
End Function

2. 结合选择操作的完整代码

调用上述函数激活零件后，即可执行选择处理逻辑：

Sub ProcessPartInAssembly()
    ' 激活零件1（替换为你的零件名称）
    Call ActivatePartInAssembly("零件1")
    
    ' 获取当前激活的零件文档
    Dim partDoc As PartDocument
    Set partDoc = CATIA.ActiveDocument
    
    ' 执行选择处理逻辑
    Dim part1 As Part
    Set part1 = partDoc.Part
    Dim selection1 As Selection
    Set selection1 = partDoc.Selection
    selection1.Clear
    
    Dim hybridBodies1 As HybridBodies
    Set hybridBodies1 = part1.HybridBodies
    
    On Error Resume Next ' 防止"External References"不存在报错
    Dim hybridBody1 As HybridBody
    Set hybridBody1 = hybridBodies1.Item("External References")
    On Error GoTo 0
    
    If Not hybridBody1 Is Nothing Then
        Dim hybridShapes1 As HybridShapes
        Set hybridShapes1 = hybridBody1.HybridShapes
        
        Dim myDict As Object
        Set myDict = CreateObject("Scripting.Dictionary")
        
        ' 收集重复名称的几何图形
        Dim Shape As HybridShape
        For Each Shape In hybridShapes1
            If myDict.Exists(Shape.Name) Then
                selection1.Add Shape
            Else
                myDict.Add Shape.Name, Shape.Name
            End If
        Next
        
        ' 收集重复名称的混合体
        Dim subHybridBody As HybridBody
        For Each subHybridBody In hybridBody1.HybridBodies
            If myDict.Exists(subHybridBody.Name) Then
                selection1.Add subHybridBody
            Else
                myDict.Add subHybridBody.Name, subHybridBody.Name
            End If
        Next
        
        ' 删除选中对象并更新
        If selection1.Count > 0 Then
            selection1.Delete
        End If
    End If
    
    selection1.Clear
    part1.Update
End Sub

说明 #

• ActivateComponent方法会让目标零件在装配环境中处于激活可编辑状态，此时CATIA的ActiveDocument会自动切换为该零件的文档
• 递归函数FindComponentByName可处理任意层级的装配结构，确保找到目标零件
• 若需激活零件2，只需修改ActivatePartInAssembly的参数为"零件2"即可

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