【CATIA的二次开发25】抽象对象Document涉及交互选择的方法

发布于：2025-06-12 ⋅ 阅读:(20) ⋅ 点赞:(0)

在CATIA VBA开发中，Document对象是最核心、最基础的对象之一。它代表了当前在CATIA会话中打开的一个文档（文件）。
几乎所有与文件操作、模型访问相关的操作都始于获取一个Document对象。Document对象包含多种方法和属性，以下介绍Document对象方法和属性

一、Document对象方法

1、方法和属性列表

2、方法分类

分类 方法 功能描述 适用文档类型 示例代码
文档激活控制 Activate 激活文档使其成为当前活动文档 所有文档类型 targetDoc.Activate
NewWindow 为文档创建新窗口 所有文档类型 doc.NewWindow
文档生命周期 Close 关闭文档 所有文档类型 doc.Close catSaveChanges
Save 保存文档 所有文档类型 If Not doc.Saved Then doc.Save
SaveAs 文档另存为 所有文档类型 doc.SaveAs “C:\NewName.CATPart”
数据交换 ExportData 导出文档为其他格式 所有文档类型 doc.ExportData “C:\export.stp”, “stp”
交互选择 Indicate2D 在2D环境(工程图)中交互选择元素 DrawingDocument Set elem = doc.Indicate2D(“选择元素”, catSelectionFilterDimension)
Indicate3D 在3D环境(零件/装配)中交互选择元素 PartDocument
ProductDocument		 Set face = doc.Indicate3D(“选择面”, catSelectionFilterFace)
对象引用 CreateReferenceFromName 通过名称创建对象引用 所有文档类型 Set ref = doc.CreateReferenceFromName(“Part1\Sketch.1”)
GetItem 通过名称获取文档中的项目(参数、关系等) 所有文档类型 Set param = doc.GetItem(“LengthParam”)
工作环境控制 GetWorkbench 获取指定工作台对象 所有文档类型 Set pdWB = doc.GetWorkbench(“PartDesignWorkbench”)
选择过滤 CreateFilter 创建选择过滤器 所有文档类型 Set filter = doc.CreateFilter(“FaceFilter”)
RemoveFilter 移除选择过滤器 所有文档类型 doc.RemoveFilter filter

二、方法～交互选择(Indicate2D方法和Indicate3D方法)

1、Indicate2D方法

在CATIA VBA开发中，Document.Indicate2D方法是一个专业级的交互式点选择工具，主要用于在2D环境（如草图或工程图）中精确获取用户选择的点坐标。
这个方法在需要用户交互的定制工具开发中特别有用，允许开发人员创建直观的点选择界面。

  • 核心功能与工作流程

    • 显示交互提示 在图形区域显示指定的提示信息，引导用户操作
    • 提供初始点 方法接受初始坐标作为起点（通常设为 (0,0)）
    • 交互式点选择 用户可通过鼠标点击或输入坐标选择点
    • 返回选择结果 方法返回用户最终选择的坐标和操作状态
    • 在工程图环境中进行交互式元素选择
    • 支持多种工程图元素类型：视图、尺寸、注解、几何等
    • 可结合选择过滤器限制可选元素类型
    • 提供用户提示信息引导选择

  • 方法语法

    Function Indicate2D(
    iPrompt As String, 
    iX As Double, 
    iY As Double, 
    oStatus As CatCaptureStatus
) As Boolean
    • iPrompt: 显示给用户的提示信息
    • iX, iY: 初始点的坐标（输入/输出参数）
    • oStatus: 返回操作状态（catCaptureNormal 或 catCaptureAbort）
    • 返回值: 用户是否确认选择（True/False）
    参数 类型 必需 说明
    Prompt String 是 用户提示信息（显示在状态栏）
    Filter SelectionFilter 否 选择过滤器对象，限制可选元素类型
    • 常用过滤器类型 (工程图)
    ' 创建工程图选择过滤器
Dim filter As SelectionFilter
Set filter = drawingDoc.CreateFilter("DrawingFilter")

' 添加可选择的元素类型
filter.AddElementType catDrawingView      ' 工程图视图
filter.AddElementType catDrawingDimension ' 尺寸标注
filter.AddElementType catDrawingText      ' 文本注解
filter.AddElementType catDrawingGeometry  ' 几何元素

  • 使用示例
    1、选择工程图视图进行操作；2、选取尺寸标注进行修改；3、识别注解元素进行更新；4、选择几何元素进行分析。

场景一：基础点选择

Sub GetSketchPoint()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 仅在草图编辑模式下有效
    If TypeName(doc.GetWorkbench("Sketcher")) <> "Nothing" Then
        Dim x As Double, y As Double
        x = 0: y = 0  ' 初始坐标
        
        Dim status As CatCaptureStatus
        Dim confirmed As Boolean
        
        ' 显示点选择提示
        confirmed = doc.Indicate2D("请选择草图点", x, y, status)
        
        If confirmed And status = catCaptureNormal Then
            MsgBox "选择的点坐标: X=" & x & ", Y=" & y
        Else
            MsgBox "用户取消了选择"
        End If
    Else
        MsgBox "请先进入草图编辑模式"
    End If
End Sub

场景二：创建基于用户输入的几何元素

Sub CreateCircleFromPoints()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    Dim part As Part
    Set part = doc.Part
    
    ' 获取圆心
    Dim centerX As Double, centerY As Double
    centerX = 0: centerY = 0
    If Not doc.Indicate2D("选择圆心位置", centerX, centerY, status) Then Exit Sub
    
    ' 获取圆周点
    Dim radiusX As Double, radiusY As Double
    radiusX = centerX + 10: radiusY = centerY  ' 默认半径点
    If Not doc.Indicate2D("选择圆周点", radiusX, radiusY, status) Then Exit Sub
    
    ' 计算半径
    Dim radius As Double
    radius = Sqr((radiusX - centerX) ^ 2 + (radiusY - centerY) ^ 2)
    
    ' 创建圆
    Dim sketch As Sketch
    Set sketch = part.HybridBodies.Item(1).HybridSketches.ActiveSketch
    sketch.OpenEdition
    Dim factory2D As Factory2D
    Set factory2D = sketch.OpenEdition
    factory2D.CreateClosedCircle centerX, centerY, radius
    sketch.CloseEdition
    part.Update
End Sub
  • 高级应用场景

场景一：动态预览创建

Sub CreateLineWithPreview()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    Dim part As Part
    Set part = doc.Part
    
    ' 起点选择
    Dim startX As Double, startY As Double
    startX = 0: startY = 0
    If Not doc.Indicate2D("选择线段起点", startX, startY, status) Then Exit Sub
    
    ' 终点选择（带动态预览）
    Dim endX As Double, endY As Double
    endX = startX + 20: endY = startY + 20  ' 初始终点
    
    ' 创建临时预览对象
    Dim preview As GeometricElement
    Set preview = CreatePreviewLine(part, startX, startY, endX, endY)
    
    ' 交互式终点选择
    Dim confirmed As Boolean
    confirmed = doc.Indicate2D("选择线段终点", endX, endY, status)
    
    ' 删除预览
    preview.Delete
    
    If confirmed Then
        ' 创建实际线段
        Dim sketch As Sketch
        Set sketch = part.HybridBodies.Item(1).HybridSketches.ActiveSketch
        sketch.OpenEdition
        Dim factory2D As Factory2D
        Set factory2D = sketch.OpenEdition
        factory2D.CreateLine startX, startY, endX, endY
        sketch.CloseEdition
        part.Update
    End If
End Sub

Function CreatePreviewLine(part As Part, x1, y1, x2, y2) As GeometricElement
    Dim tempSketch As Sketch
    Set tempSketch = part.HybridBodies.Add.HybridSketches.Add(part.OriginElements.PlaneXY)
    tempSketch.OpenEdition
    Dim factory2D As Factory2D
    Set factory2D = tempSketch.OpenEdition
    Set CreatePreviewLine = factory2D.CreateLine(x1, y1, x2, y2)
    tempSketch.CloseEdition
End Function

场景二：工程图尺寸标注辅助

Sub AddCustomDimension()
    Dim drawing As DrawingDocument
    Set drawing = CATIA.ActiveDocument
    
    ' 选择第一个点
    Dim x1 As Double, y1 As Double
    x1 = 0: y1 = 0
    If Not drawing.Indicate2D("选择第一个尺寸点", x1, y1, status) Then Exit Sub
    
    ' 选择第二个点
    Dim x2 As Double, y2 As Double
    x2 = x1 + 50: y2 = y1  ' 初始位置
    If Not drawing.Indicate2D("选择第二个尺寸点", x2, y2, status) Then Exit Sub
    
    ' 选择尺寸线位置
    Dim dimX As Double, dimY As Double
    dimX = (x1 + x2) / 2: dimY = y1 - 20
    If Not drawing.Indicate2D("选择尺寸线位置", dimX, dimY, status) Then Exit Sub
    
    ' 添加尺寸
    Dim view As DrawingView
    Set view = drawing.Sheets.ActiveSheet.Views.ActiveView
    Dim dims As DrawingDimensions
    Set dims = view.Dimensions
    
    ' 创建临时点对象
    Dim point1 As DrawingPoint, point2 As DrawingPoint
    Set point1 = view.Factory2D.CreatePoint(x1, y1)
    Set point2 = view.Factory2D.CreatePoint(x2, y2)
    
    ' 添加尺寸
    dims.AddLength point1, point2, dimX, dimY
    
    ' 清理临时点
    point1.Delete
    point2.Delete
End Sub
  • 关键特性与注意事项
    1. 环境依赖性
      • 仅在草图编辑器或工程图工作台中有效
      • 在 3D 环境中调用会返回错误
    2. 坐标系统
      • 坐标基于当前激活的草图平面或工程图视图坐标系
      • 在装配环境中使用时，坐标相对于激活的部件
    3. 用户交互模式
      • 方法执行时会阻塞代码执行，等待用户操作
      • 用户可按 ESC 取消操作（返回 catCaptureAbort）
    4. 多文档处理
    ' 在特定文档中激活选择
Sub SelectInSpecificDoc(targetDoc As Document)
    Dim activeDoc As Document
    Set activeDoc = CATIA.ActiveDocument
    
    ' 切换到目标文档
    targetDoc.Activate
    
    ' 执行点选择
    Dim x As Double, y As Double
    targetDoc.Indicate2D "在目标文档中选择点", x, y, status
    
    ' 恢复原始文档
    activeDoc.Activate
End Sub
    1. 精度控制
    ' 启用网格捕捉
Application.SettingCaptures.GridSnapMode = True
Application.SettingCaptures.GridSpacing = 5.0 ' 5mm网格
  • 高级技巧与最佳实践
    • 自定义输入验证
    Function GetValidatedPoint(prompt As String) As Variant
    Dim x As Double, y As Double
    x = 0: y = 0
    Dim status As CatCaptureStatus
  
    Do
        If Not CATIA.ActiveDocument.Indicate2D(prompt, x, y, status) Then
            GetValidatedPoint = Array(Empty, Empty)
            Exit Function
        End If
      
        ' 检查点是否在有效区域内
        If x >= 0 And x <= 100 And y >= 0 And y <= 100 Then
            Exit Do
        Else
            MsgBox "点必须在0-100范围内，请重新选择"
        End If
    Loop
  
    GetValidatedPoint = Array(x, y)
End Function
    • 结合键盘输入
    Sub CreatePointWithInput()
    Dim x As Double, y As Double
    x = 0: y = 0
    Dim status As CatCaptureStatus
  
    ' 允许键盘输入坐标
    Application.SettingCaptures.KeyboardInputMode = True
  
    If CATIA.ActiveDocument.Indicate2D("输入或选择点位置", x, y, status) Then
        ' 创建点
        Dim sketch As Sketch
        Set sketch = CATIA.ActiveDocument.Pa

网站公告

今日签到

点亮在社区的每一天
去签到

热门文章

最新发布