CATIA VBA零件体分割脚本故障，请求技术排查支持

需对名为FUEL TANK的零件体执行分割操作，利用“Geometrical Set.2”几何集中的多个HybridShapePlaneOffset偏移平面评估燃油箱油耗数据，但编写的VBA脚本运行异常，以下是脚本、模型截图及问题排查：

脚本代码 #

Sub CATMain()

  
    Dim partDocument1 As Document
    Set partDocument1 = CATIA.ActiveDocument
    
    Dim part1 As Part
    Set part1 = partDocument1.Part
    
    Dim shapeFactory1 As ShapeFactory
    Set shapeFactory1 = part1.ShapeFactory
    
    Dim myBody As Body
    Set myBody = part1.Bodies.Item("FUEL TANK")
    part1.InWorkObject = myBody
    
    Dim hybridBody1 As HybridBody
    Set hybridBody1 = part1.HybridBodies.Item("Geometrical Set.2")
    
    Dim fileName As String
    fileName = "C:\Users\Izabel Russo\Downloads\FUEL TANK.csv"
    Dim fileNumber As Integer
    fileNumber = FreeFile
    Open fileName For Output As fileNumber
    Print #fileNumber, "Plan, Volume, Area, Mass, Density, Gx, Gy, Gz, IoxG, IoyG, IozG, IxyG, IxzG, IyzG"
    
    Dim i As Integer
    For i = 1 To hybridBody1.HybridShapes.Count
        Dim plane As HybridShapePlaneOffset
        Set plane = hybridBody1.HybridShapes.Item(i)
        Dim reference2 As Reference
        Set reference2 = part1.CreateReferenceFromObject(plane)
        
        Dim reference1 As Reference
        Set reference1 = part1.CreateReferenceFromName("")
        
        Dim split1 As Split
        Set split1 = shapeFactory1.AddNewSplit(reference1, catPositiveSide)
        split1.Surface = reference2
        part1.Update
        
        Dim selection1 As Selection
        Set selection1 = partDocument1.Selection
        selection1.Clear
        selection1.Add myBody
        
        Dim spaWorkbench As Workbench
        Set spaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
        
        Dim referenceToMyBody As Reference
        Set referenceToMyBody = part1.CreateReferenceFromObject(myBody)
        
        Dim measurable As Measurable
        Set measurable = spaWorkbench.GetMeasurable(referenceToMyBody)
        
        Dim volume As Double
        volume = measurable.Volume
        
        Dim area As Double
        area = measurable.Area
        
        Dim mass As Double
        mass = measurable.Mass
        
        Dim density As Double
        density = measurable.Density
        
        Dim inertia(8) As Double
        measurable.GetInertia inertia
        
        Dim cg(2) As Double
        measurable.GetCOG cg
        
        Print #fileNumber, i & ", " & volume & ", " & area & ", " & mass & ", " & density & ", " & cg(0) & ", " & cg(1) & ", " & cg(2) & ", " & inertia(0) & ", " & inertia(1) & ", " & inertia(2) & ", " & inertia(3) & ", " & inertia(4) & ", " & inertia(5)
        
        selection1.Clear
        selection1.Add split1
        selection1.Delete
        part1.Update
    Next i
    
    Close fileNumber
    
    MsgBox "Done."
End Sub

模型截图 #

问题排查及修复 #

• 分割对象参数错误：AddNewSplit第一个参数需传入要分割的零件体参考，脚本中reference1 = part1.CreateReferenceFromName("")是空引用，直接导致分割失败，替换为：

  Dim reference1 As Reference
  Set reference1 = part1.CreateReferenceFromObject(myBody)
  

• 更新时机错误：创建分割后需先将分割设为工作对象再更新，否则分割关联不完整：

  part1.InWorkObject = split1
  part1.Update
  

• 类型转换风险：直接将几何集内特征强制转为HybridShapePlaneOffset，若存在非偏移平面特征会触发类型不匹配，需添加判断：

  If TypeOf hybridBody1.HybridShapes.Item(i) Is HybridShapePlaneOffset Then
      Set plane = hybridBody1.HybridShapes.Item(i)
      ' 后续分割测量逻辑
  Else
      Print #fileNumber, i & ", 非偏移平面特征，跳过"
  End If
  

• 删除分割前的工作对象重置：删除分割特征前需将零件体设回工作对象，避免后续操作报错：

  part1.InWorkObject = myBody
  selection1.Clear
  selection1.Add split1
  selection1.Delete
  

• 硬编码路径风险：固定CSV路径可能因权限或路径不存在导致文件创建失败，可替换为用户选择路径：

  Dim fd As FileDialog
  Set fd = Application.FileDialog(msoFileDialogSaveAs)
  fd.Filter = "CSV文件 (*.csv)|*.csv"
  If fd.Show = -1 Then
      fileName = fd.SelectedItems(1)
  Else
      Exit Sub
  End If
  

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