【CATIA的二次开发24】抽象对象Document涉及文档生命周期的方法

在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(“Part1Sketch.1”)
GetItem 通过名称获取文档中的项目(参数、关系等) 所有文档类型 Set param = doc.GetItem(“LengthParam”)
工作环境控制 GetWorkbench 获取指定工作台对象 所有文档类型 Set pdWB = doc.GetWorkbench(“PartDesignWorkbench”)
选择过滤 CreateFilter 创建选择过滤器 所有文档类型 Set filter = doc.CreateFilter(“FaceFilter”)
RemoveFilter 移除选择过滤器 所有文档类型 doc.RemoveFilter filter

二、方法~文档生命周期(Close方法、Save方法和SaveAs方法)

1、Close方法

在 CATIA VBA 开发中,Document 对象的 Close 方法 用于关闭当前文档。
这是管理文档生命周期的重要方法,允许开发者以编程方式控制文档的关闭行为,特别是处理未保存的更改时。

方法功能

关闭当前文档,释放系统资源
可选择保存或不保存更改
关闭后文档对象引用失效

方法语法

Sub Close([SaveChanges As CatSaveStatus])

SaveChanges (可选参数):
指定关闭时如何处理未保存的更改,使用 CatSaveStatus 枚举值:

catSaveForClosing (默认值):提示用户保存(如果有未保存更改)
catDoNotSaveChanges:不保存直接关闭
catSaveChanges:保存更改后关闭

参数值 常量 行为
保存更改 catSaveChanges 1 保存更改后关闭
不保存更改 catDoNotSaveChanges 2 不保存直接关闭
未指定参数 对未保存文档弹出保存提示框

使用示例
1、完成操作后清理资源;2、批量处理多个文档;3、实现文档自动清理机制;4、关闭不需要的临时文档。

场景一:默认关闭(提示保存)

Dim doc As Document
Set doc = CATIA.ActiveDocument
doc.Close  ' 等同于 doc.Close catSaveForClosing

场景二:强制不保存关闭

doc.Close catDoNotSaveChanges  ' 放弃所有未保存的更改

场景三:保存后关闭

doc.Close catSaveChanges  ' 自动保存后关闭文档

场景四:关闭所有打开文档

Dim docs As Documents
Set docs = CATIA.Documents

' 必须从后向前遍历(关闭后集合会变化)
For i = docs.Count To 1 Step -1
    docs.Item(i).Close catDoNotSaveChanges  ' 不保存关闭所有
Next i

关键特性与注意事项

未保存文档处理
新建未保存文档使用 catSaveChanges 会触发”另存为”对话框

Dim newDoc As Document
Set newDoc = CATIA.Documents.Add("Part")
newDoc.Close catSaveChanges  ' 弹出保存对话框

关闭后对象状态
关闭后文档对象即失效,继续访问会引发运行时错误

doc.Close
Debug.Print doc.Name  ' 错误 424: 对象已释放!

只读文档行为

Set doc = CATIA.Documents.Open("C:ReadOnly.Part", True) ' 以只读打开
doc.Close catSaveChanges  ' 忽略保存请求直接关闭

与保存状态的关系

If doc.Saved = False Then
    ' 有未保存更改时的特殊处理
    doc.Close catSaveChanges
Else
    doc.Close catDoNotSaveChanges
End If

错误处理

On Error Resume Next
doc.Close
If Err.Number = -2147220698 Then
    MsgBox "文档已被其他进程锁定"
ElseIf Err.Number <> 0 Then
    MsgBox "关闭错误: " & Err.Description
End If

⚠️ 重要提示:关闭文档后,所有关联对象(如 Part、Product 等)都会失效。
继续使用这些对象引用将导致”对象已释放”错误(Error 424)。

最佳实践

安全关闭函数

Sub SafeCloseDocument(targetDoc As Document, Optional saveOption As CatSaveStatus = catSaveForClosing)
    On Error Resume Next
    ' 检查文档是否有效
    If targetDoc Is Nothing Then Exit Sub
    
    ' 检查文档是否已关闭
    Dim testName As String
    testName = targetDoc.Name  ' 尝试访问属性
    
    If Err.Number = 0 Then
        targetDoc.Close saveOption
    Else
        Err.Clear  ' 清除错误
    End If
End Sub

关闭前保存检查

Sub CloseWithBackup(doc As Document)
    If Not doc.Saved Then
        Dim backupPath As String
        backupPath = "C:Backups" & Format(Now, "yyyymmdd_hhmmss_") & doc.Name
        
        doc.SaveAs backupPath  ' 创建备份
        MsgBox "已创建备份: " & backupPath
    End If
    
    doc.Close catDoNotSaveChanges
End Sub

2、Save方法

在 CATIA VBA 开发中,Document.Save 方法 是文档持久化的核心操作,用于将当前文档的修改保存到其关联文件。
这个方法在自动化工作流中至关重要,确保设计变更被正确持久化,避免数据丢失。

方法功能

将文档保存到当前关联文件
对新建文档会触发”另存为”对话框
更新文件修改时间和版本信息
清除”未保存”状态标志
新建文档:弹出”另存为”对话框
只读文档:保存失败,返回错误
未更改文档:无操作,直接返回

方法语法

Sub Save()

对已保存过的文档:覆盖原文件
对新文档:触发”另存为”对话框(等同于 SaveAs)

关键特性与行为
1、定期自动保存;2、关键操作后保存进度;3、文档修改后持久化存储;4、准备导出或共享前的保存。

场景一:保存状态管理

Dim doc As Document
Set doc = CATIA.ActiveDocument

' 检查文档是否需要保存
If Not doc.Saved Then
    ' 执行保存操作
    doc.Save
    MsgBox "文档已保存: " & doc.FullName
Else
    MsgBox "文档无修改,无需保存"
End If

场景二:新文档处理

' 创建新文档
Dim newDoc As Document
Set newDoc = CATIA.Documents.Add("Part")

' 添加内容...
newDoc.Part.HybridBodies.Add

' 首次保存会触发另存为行为
newDoc.Save  ' 将弹出保存对话框

场景三:只读文档处理

If doc.ReadOnly Then
    ' 只读文档需要另存为
    doc.SaveAs "C:Modified_" & doc.Name
Else
    doc.Save
End If

高级应用场景

场景一: 批量保存所有修改文档

Sub SaveAllModifiedDocuments()
    Dim docs As Documents
    Set docs = CATIA.Documents
    
    Dim doc As Document
    For Each doc In docs
        If Not doc.Saved And Not doc.ReadOnly Then
            On Error Resume Next ' 错误处理
            doc.Save
            If Err.Number = 0 Then
                LogAction "已保存: " & doc.Name
            Else
                LogAction "保存失败: " & doc.Name & " - " & Err.Description
            End If
            On Error GoTo 0
        End If
    Next
End Sub

场景二: 带版本控制的自动保存

Sub AutoSaveWithVersioning()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    Dim version As Integer
    
    ' 获取当前版本号
    version = GetDocumentVersion(doc)
    
    ' 生成版本化文件名
    Dim newPath As String
    newPath = "C:Versions" & GetBaseName(doc.Name) & "_v" & version + 1 & ".CATPart"
    
    ' 执行版本保存
    doc.SaveAs newPath
    UpdateVersionMetadata(doc, version + 1)
End Sub

Function GetDocumentVersion(doc As Document) As Integer
    ' 从自定义属性获取版本号
    On Error Resume Next
    GetDocumentVersion = doc.Part.UserRefProperties.Item("Version").Value
    If Err.Number <> 0 Then
        GetDocumentVersion = 1 ' 默认版本
    End If
End Function

场景三: 保存前自动清理

Sub CleanAndSave()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 仅零件文档需要清理
    If doc.Type = "Part" Then
        ' 压缩历史记录
        doc.Part.CompressHistory
        
        ' 删除空几何图形集
        Dim hybridBody As HybridBody
        For Each hybridBody In doc.Part.HybridBodies
            If hybridBody.HybridShapes.Count = 0 Then
                hybridBody.Delete
            End If
        Next
    End If
    
    ' 执行保存
    doc.Save
End Sub

场景四:保存到云存储

Sub SaveToCloudStorage()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 本地临时保存
    Dim tempPath As String
    tempPath = Environ("TEMP") & "" & doc.Name
    doc.SaveAs tempPath
    
    ' 上传到云存储
    Dim cloudService As Object
    Set cloudService = CreateObject("CloudStorage.API")
    cloudService.UploadFile tempPath, "https://api.cloud.com/designs"
    
    ' 清理临时文件
    Kill tempPath
End Sub

错误处理与解决方案

文件锁定错误处理

Sub SafeSave()
    On Error GoTo ErrorHandler
    CATIA.ActiveDocument.Save
    Exit Sub
    
ErrorHandler:
    Select Case Err.Number
        Case -2147220991 ' 文件被占用
            Dim newPath As String
            newPath = "C:Backup" & Format(Now, "yyyymmdd_hhmmss_") & CATIA.ActiveDocument.Name
            CATIA.ActiveDocument.SaveAs newPath
            MsgBox "原文件被锁定,已另存为: " & newPath
            
        Case -2147467259 ' 只读错误
            If MsgBox("文档为只读,是否另存为?", vbYesNo) = vbYes Then
                CATIA.ActiveDocument.SaveAs "C:Modified_" & CATIA.ActiveDocument.Name
            End If
            
        Case Else
            MsgBox "保存错误 " & Err.Number & ": " & Err.Description
    End Select
End Sub

磁盘空间检查

Sub SaveWithSpaceCheck()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    Dim requiredSpace As Long
    
    ' 预估保存所需空间 (MB)
    requiredSpace = EstimateDocumentSize(doc) 
    
    If GetFreeSpace(doc.Path) < requiredSpace Then
        If MsgBox("磁盘空间不足,尝试清理?", vbYesNo) = vbYes Then
            CleanUpDiskSpace doc.Path, requiredSpace
        Else
            Exit Sub
        End If
    End If
    
    doc.Save
End Sub

Function GetFreeSpace(path As String) As Long ' 返回MB
    Dim fso As Object, drive As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set drive = fso.GetDrive(fso.GetDriveName(path))
    GetFreeSpace = drive.FreeSpace / 1048576 ' 字节转MB
End Function

保存冲突解决

Sub ResolveSaveConflict()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 检查外部修改
    If FileModifiedExternally(doc.FullName) Then
        Select Case MsgBox("文件已被外部修改,如何处理?" & vbCrLf & _
                          "是 = 覆盖保存" & vbCrLf & _
                          "否 = 另存为新文件" & vbCrLf & _
                          "取消 = 放弃保存", _
                          vbYesNoCancel)
            Case vbYes: doc.Save
            Case vbNo: doc.SaveAs "C:ConflictResolved_" & doc.Name
            Case vbCancel: Exit Sub
        End Select
    Else
        doc.Save
    End If
End Sub

性能优化技巧

大型装配保存优化

Sub OptimizedSaveForLargeAssembly()
    Dim product As Product
    Set product = CATIA.ActiveDocument.Product
    
    ' 禁用轻量化更新
    product.UpdateMode = catManualUpdate
    
    ' 隐藏所有组件减少刷新
    product.VisProperties.SetShowMode catVisModeHide
    
    ' 保存文档
    CATIA.ActiveDocument.Save
    
    ' 恢复显示
    product.VisProperties.SetShowMode catVisModeShow
    product.UpdateMode = catAutomaticUpdate
    product.Update
End Sub

增量保存策略

Sub IncrementalSave()
    Static lastSaveTime As Date
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 每15分钟自动保存
    If DateDiff("n", lastSaveTime, Now) >= 15 Then
        doc.Save
        lastSaveTime = Now
        LogAction "自动保存: " & doc.Name
    End If
End Sub

后台保存技术

Sub BackgroundSave()
    ' 保存原始显示设置
    Dim origMode As Long
    origMode = CATIA.ActiveWindow.ActiveViewer.DisplayMode
    
    ' 最小化图形更新
    CATIA.ActiveWindow.ActiveViewer.DisplayMode = catWireFrameMode
    Application.RefreshDisplay = False
    
    ' 执行保存
    CATIA.ActiveDocument.Save
    
    ' 恢复显示设置
    Application.RefreshDisplay = True
    CATIA.ActiveWindow.ActiveViewer.DisplayMode = origMode
End Sub

企业级应用方案

场景一:PDM系统集成保存

Sub SaveToPDMSystem()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 标准保存
    doc.Save
    
    ' 检查入PDM系统
    If IsIntegratedWithPDM() Then
        Dim pdmID As String
        pdmID = GetPDMDocID(doc)
        
        If pdmID = "" Then
            ' 初次入库
            pdmID = CreatePDMDocument(doc)
        End If
        
        ' 更新PDM版本
        UpdatePDMVersion pdmID, doc
    End If
End Sub

场景二:自动保存与备份系统

Sub AutoSaveAndBackup()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    Dim backupPath As String
    
    ' 主保存
    doc.Save
    
    ' 创建备份
    backupPath = "X:Backups" & Format(Now, "yyyymmdd") & "" & doc.Name
    If Not FolderExists(backupPath) Then CreateFolderTree(backupPath)
    
    ' 使用副本保存避免锁定
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile doc.FullName, backupPath
End Sub

场景三:保存时自动生成报告

Sub SaveWithReportGeneration()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 保存主文档
    doc.Save
    
    ' 生成PDF报告
    If doc.Type = "Part" Then
        GeneratePDFReport doc, "C:Reports" & GetBaseName(doc.Name) & ".pdf"
    End If
    
    ' 生成BOM表
    If doc.Type = "Product" Then
        ExportBOM doc, "C:BOMs" & GetBaseName(doc.Name) & ".xlsx"
    End If
End Sub

最佳实践指南

场景一:保存前验证

Sub ValidateBeforeSave()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 执行模型检查
    If Not ValidateModel(doc) Then
        MsgBox "模型验证失败,无法保存", vbCritical
        Exit Sub
    End If
    
    ' 检查未更新特征
    If HasOutdatedFeatures(doc) Then
        If MsgBox("存在未更新特征,是否更新后保存?", vbYesNo) = vbYes Then
            doc.Part.Update
        End If
    End If
    
    doc.Save
End Sub

场景二:保存日志记录

Sub LoggedSave()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    doc.Save
    
    ' 记录保存操作
    AddSaveHistoryEntry doc, Environ("USERNAME")
End Sub

Sub AddSaveHistoryEntry(doc As Document, user As String)
    Dim params As Parameters
    Set params = doc.Part.Parameters
    
    On Error Resume Next
    Dim historyParam As StrParam
    Set historyParam = params.Item("SaveHistory")
    
    If Err.Number <> 0 Then
        Set historyParam = params.CreateString("SaveHistory", "保存历史")
        historyParam.Value = ""
    End If
    
    historyParam.Value = historyParam.Value & _
        user & " | " & Now & " | " & doc.FullName & vbCrLf
End Sub

场景三:保存后清理内存

Sub SaveAndReleaseMemory()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 保存文档
    doc.Save
    
    ' 内存优化
    If doc.Type = "Part" Then
        doc.Part.HybridBodies.Purge
        doc.Part.ShapeFactory.Clean
    End If
    
    ' 强制垃圾回收
    SetNothingRecursive doc
End Sub

Sub SetNothingRecursive(obj As Object)
    Dim field As Object
    For Each field In obj.Fields
        If IsObject(field.Value) Then
            SetNothingRecursive field.Value
            Set field.Value = Nothing
        End If
    Next
End Sub

总结
Document.Save 方法是 CATIA VBA 自动化中最关键的操作之一,合理使用需注意:

状态检查:始终检查 Saved 属性避免不必要操作
错误处理:完善处理文件锁定、只读等常见问题
版本控制:实现自动版本管理避免覆盖重要数据
企业集成:与 PDM/PLM 系统深度整合
性能优化:大型模型采用特殊保存策略
自动化扩展:结合报告生成、备份等扩展功能
通过结合上述高级技巧,可以构建健壮的保存系统,满足从简单脚本到企业级自动化解决方案的各种需求。

3、SaveAs方法

在 CATIA VBA 开发中,Document.SaveAs 方法 是文档管理的核心操作,用于将文档保存为新文件或转换为不同格式。
与 Save 方法不同,SaveAs 提供了更灵活的文件管理能力,特别适用于版本控制、格式转换和自动化归档等场景。

方法功能

将文档另存为指定路径的新文件
原文档保持打开状态不变
新文档自动打开并成为活动文档
需要设置CurrentFilter属性指定格式
格式控制:通过CurrentFilter属性设置输出格式
路径处理:自动添加扩展名(基于CurrentFilter)
窗口管理:新文档成为活动文档
原文档:保持打开,引用不变

方法语法

Sub SaveAs(FileName As String)

FileName: 目标文件的完整路径(包括扩展名)

核心功能与行为特点

路径与扩展名规则

文档类型 有效扩展名 示例
零件文档 .CATPart C:PartsBracket_V2.CATPart
装配文档 .CATProduct D:AssembliesEngine_V3.CATProduct
工程图文档 .CATDrawing E:DrawingsAssembly_Drawing_RevB.CATDrawing
创成式外形文档 .CATShape F:SurfacesCarBody_Final.CATShape

⚠️ 扩展名必须匹配文档类型,否则会引发错误

所有权转移

Dim originalDoc As Document
Set originalDoc = CATIA.ActiveDocument
originalDoc.SaveAs "C:NewPathNewName.CATPart"

' 原文档仍保持打开状态
Debug.Print originalDoc.FullName  ' 输出原路径

' 新文档自动创建并激活
Dim newDoc As Document
Set newDoc = CATIA.ActiveDocument
Debug.Print newDoc.FullName  ' 输出 "C:NewPathNewName.CATPart"

格式转换能力

' 将零件转换为STEP格式
CATIA.ActiveDocument.SaveAs "C:ExportsPartModel.stp"

' 将工程图保存为PDF
CATIA.ActiveDocument.SaveAs "D:ReportsTechnicalDrawing.pdf"

高级应用场景
1、创建文档副本;2、格式转换(CATPart → STEP);3、版本控制(保存不同版本);4、模板应用(从模板创建新设计)。

场景一:版本化自动命名

Sub AutoVersionedSave()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    Dim baseName As String
    baseName = GetBaseName(doc.Name) ' 移除扩展名
    
    ' 查找最高版本
    Dim version As Integer
    version = FindMaxVersion("C:Designs", baseName)
    
    ' 构建新路径
    Dim newPath As String
    newPath = "C:Designs" & baseName & "_v" & version + 1 & _
              GetExtension(doc.Type)
    
    ' 执行另存为
    doc.SaveAs newPath
End Sub

Function GetExtension(docType As String) As String
    Select Case docType
        Case "Part": GetExtension = ".CATPart"
        Case "Product": GetExtension = ".CATProduct"
        Case "Drawing": GetExtension = ".CATDrawing"
    End Select
End Function

场景二:批量格式转换工具

Sub BatchConvertFormat(sourceFolder As String, targetFormat As String)
    Dim fso As Object, folder As Object, file As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(sourceFolder)
    
    For Each file In folder.Files
        If IsCatiaFile(file.Name) Then
            Dim doc As Document
            Set doc = CATIA.Documents.Open(file.Path)
            
            Dim newPath As String
            newPath = fso.BuildPath("C:Converted", _
                     fso.GetBaseName(file.Name) & "." & targetFormat)
            
            doc.SaveAs newPath
            doc.Close
        End If
    Next
End Sub

场景三:企业级归档系统

Sub ArchiveToPLMSystem()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 生成归档路径
    Dim archivePath As String
    archivePath = GeneratePLMPath(doc)
    
    ' 保存到PLM中间区
    doc.SaveAs archivePath
    
    ' 触发PLM入库
    Dim plm As Object
    Set plm = CreateObject("PLM.Integration")
    plm.CheckInDocument archivePath, _
        "AutoSave " & Format(Now, "yyyy-mm-dd"), _
        Environ("USERNAME")
End Sub

Function GeneratePLMPath(doc As Document) As String
    Dim plmRoot As String
    plmRoot = "\PLMServerIncoming"
    
    Dim projectCode As String
    projectCode = doc.Part.Parameters.Item("ProjectCode").Value
    
    Dim partNumber As String
    partNumber = doc.Part.Parameters.Item("PartNumber").Value
    
    GeneratePLMPath = plmRoot & projectCode & "" & _
                      Format(Now, "yyyymm") & "" & _
                      partNumber & "_Rev" & _
                      doc.Part.Parameters.Item("Revision").Value & _
                      GetExtension(doc.Type)
End Function

关键技术细节

格式选项控制

Sub SaveWithOptions()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 获取格式选项对象
    Dim saveOptions As Object
    Set saveOptions = CATIA.GetItem("CATIAOptionsSave")
    
    ' 配置STEP保存选项
    saveOptions.SetOption "STEP", "AP", "214"  ' AP214协议
    saveOptions.SetOption "STEP", "ExportProductAs", "OneFile"  ' 装配存为单文件
    
    ' 执行保存
    doc.SaveAs "C:ExportsAssembly_STEP214.stp"
    
    ' 恢复默认设置
    saveOptions.RestoreDefaults
End Sub

轻量化保存模式

Sub SaveAsLightweight()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 仅适用于装配文档
    If doc.Type = "Product" Then
        ' 启用轻量化模式
        doc.Product.SetAttribute "SaveLightweight", "True"
        
        ' 执行保存
        doc.SaveAs "D:LightweightAssembliesEngine_Light.CATProduct"
        
        ' 恢复设置
        doc.Product.SetAttribute "SaveLightweight", "False"
    End If
End Sub

增量保存技术

Dim saveCounter As Integer

Sub IncrementalSaveAs()
    saveCounter = saveCounter + 1
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 生成增量保存路径
    Dim incPath As String
    incPath = "X:AutoSave" & GetBaseName(doc.Name) & "_INC" & _
              Format(saveCounter, "000") & GetExtension(doc.Type)
    
    ' 执行保存
    doc.SaveAs incPath
End Sub

错误处理与解决方案

路径无效错误处理

Sub SafeSaveAs(path As String)
    On Error GoTo ErrorHandler
    
    ' 创建目标目录
    CreatePathIfMissing path
    
    CATIA.ActiveDocument.SaveAs path
    Exit Sub
    
ErrorHandler:
    Select Case Err.Number
        Case -2147220991: ' 路径无效
            MsgBox "路径格式错误: " & path, vbCritical
        Case -2147467259: ' 权限不足
            MsgBox "无写入权限: " & path, vbCritical
        Case Else
            MsgBox "错误 " & Err.Number & ": " & Err.Description
    End Select
End Sub

Sub CreatePathIfMissing(fullPath As String)
    Dim fso As Object, folderPath As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    folderPath = fso.GetParentFolderName(fullPath)
    
    If Not fso.FolderExists(folderPath) Then
        fso.CreateFolder folderPath
    End If
End Sub

文件名冲突解决

Sub SaveAsWithConflictResolution(basePath As String)
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim newPath As String
    newPath = basePath
    
    ' 检查并解决冲突
    Dim counter As Integer
    counter = 1
    
    While fso.FileExists(newPath)
        newPath = fso.BuildPath(fso.GetParentFolderName(basePath), _
                 fso.GetBaseName(basePath) & "_" & counter & _
                 fso.GetExtensionName(basePath))
        counter = counter + 1
    Wend
    
    doc.SaveAs newPath
End Sub

磁盘空间监控

Sub SaveAsWithSpaceCheck(path As String)
    Dim requiredSpace As Long
    requiredSpace = EstimateFileSize(CATIA.ActiveDocument) ' MB
    
    Dim freeSpace As Long
    freeSpace = GetDiskFreeSpace(Left(path, 1)) ' 获取磁盘空间
    
    If freeSpace < requiredSpace * 1.2 Then ' 保留20%缓冲
        If Not FreeUpSpace(path, requiredSpace * 1.2) Then
            MsgBox "磁盘空间不足,无法保存", vbCritical
            Exit Sub
        End If
    End If
    
    CATIA.ActiveDocument.SaveAs path
End Sub

企业级应用方案

PDM集成保存工作流

Sub SaveAsToPDM()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 生成PDM合规路径
    Dim pdmPath As String
    pdmPath = GeneratePDMPath(doc)
    
    ' 执行另存为
    doc.SaveAs pdmPath
    
    ' 自动添加属性
    AddPDMMetadata doc
    
    ' 触发工作流
    StartPDMWorkflow pdmPath
End Sub

Function GeneratePDMPath(doc As Document) As String
    Dim pdm As Object
    Set pdm = CreateObject("Teamcenter.SOAP")
    
    Dim itemId As String
    itemId = pdm.CreateItem( _
        doc.Part.Parameters.Item("PartNumber").Value, _
        doc.Part.Parameters.Item("Revision").Value, _
        GetPDMType(doc.Type))
    
    GeneratePDMPath = pdm.GetWorkspacePath(itemId)
End Function

自动发布系统

Sub PublishDesignPackage()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 创建临时发布目录
    Dim publishDir As String
    publishDir = "C:Publish" & Format(Now, "yyyymmdd_hhmm") & ""
    CreateFolderTree publishDir
    
    ' 保存主文档
    doc.SaveAs publishDir & doc.Name
    
    ' 保存相关依赖
    If doc.Type = "Product" Then
        SaveDependencies doc, publishDir
    End If
    
    ' 生成PDF报告
    GeneratePDFReport doc, publishDir & "DesignReport.pdf"
    
    ' 打包ZIP
    CreateZipPackage publishDir
End Sub

云存储集成

Sub SaveToCloudStorage(cloudProvider As String)
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 本地临时保存
    Dim tempPath As String
    tempPath = Environ("TEMP") & "" & doc.Name
    doc.SaveAs tempPath
    
    ' 云服务选择
    Dim cloud As Object
    Select Case cloudProvider
        Case "OneDrive": Set cloud = CreateObject("OneDrive.API")
        Case "Dropbox": Set cloud = CreateObject("Dropbox.Client")
        Case "GoogleDrive": Set cloud = CreateObject("GDrive.Integration")
    End Select
    
    ' 上传文件
    cloud.UploadFile tempPath, "/CAD_Designs/" & doc.Name
    
    ' 清理临时文件
    Kill tempPath
    
    ' 添加云链接到文档属性
    doc.Part.UserRefProperties.CreateString("CloudURL", _
        cloud.GetShareLink("/CAD_Designs/" & doc.Name))
End Sub

最佳实践指南

元数据自动注入

Sub SaveAsWithMetadata(newPath As String)
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 添加保存元数据
    doc.Part.UserRefProperties.CreateString("LastSavedBy", Environ("USERNAME"))
    doc.Part.UserRefProperties.CreateString("LastSavedPath", newPath)
    doc.Part.UserRefProperties.CreateString("LastSavedDate", Format(Now, "yyyy-mm-dd hh:mm"))
    
    ' 保存文档
    doc.SaveAs newPath
End Sub

保存前验证检查

Sub ValidatedSaveAs(path As String)
    If Not PassesDesignRules(CATIA.ActiveDocument) Then
        MsgBox "设计规则检查失败,无法保存", vbCritical
        Exit Sub
    End If
    
    If Not PassesInterferenceCheck(CATIA.ActiveDocument) Then
        If MsgBox("存在干涉问题,仍要保存吗?", vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If
    
    CATIA.ActiveDocument.SaveAs path
End Sub

自动化备份系统

Sub SaveAsWithBackup(newPath As String)
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 创建备份
    If doc.FullName <> "" Then
        Dim backupDir As String
        backupDir = "X:Backups" & Format(Now, "yyyymmdd") & ""
        CreateFolderTree backupDir
        
        FileCopy doc.FullName, backupDir & doc.Name
    End If
    
    ' 执行另存为
    doc.SaveAs newPath
End Sub

保存后清理优化

Sub CleanSaveAs(path As String)
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 压缩历史记录
    If doc.Type = "Part" Then
        doc.Part.CompressHistory
    End If
    
    ' 删除未使用元素
    RemoveUnusedElements doc
    
    ' 优化几何体
    OptimizeGeometry doc
    
    ' 执行保存
    doc.SaveAs path
End Sub

总结
Document.SaveAs 方法是 CATIA VBA 自动化中最强大的文件管理工具,关键应用包括:
版本控制:实现自动化版本迭代
格式转换:无缝转换文件格式
数据分发:创建特定配置的输出
系统集成:与 PDM/PLM/云存储对接
归档备份:构建企业级备份方案
通过结合路径管理、错误处理和企业集成技术,可以构建强大的自动化保存系统,满足从简单重命名到复杂企业工作流的各种需求。

核心原则包括:

路径验证:确保目标路径有效且可写
冲突解决:自动处理文件名冲突
元数据管理:注入关键设计信息
依赖处理:正确处理装配依赖关系
企业集成:无缝对接企业管理系统

三、Close方法、Save方法和SaveAs方法对比

在 CATIA VBA 开发中,Close、Save 和 SaveAs 是文档生命周期管理的核心方法。
它们共同负责文档的持久化存储和资源管理,是自动化工作流中不可或缺的部分。
以下是这三个方法的详细对比和用法说明:

特性 Close 方法 Save 方法 SaveAs 方法
主要功能 关闭文档 保存文档 文档另存为
语法 Document.Close([SaveChanges]) Document.Save() Document.SaveAs(FileName)
参数 SaveChanges (可选) FileName (必需)
返回值
适用文档类型 所有文档类型 所有文档类型 所有文档类型
对原文档影响 文档被关闭,引用失效 更新文件内容 创建新文件,原文档不变
新文档处理 新文档自动打开并成为活动文档
未保存处理 通过参数控制 直接保存 直接另存
文件对话框 可能触发(新建文档未保存时) 新建文档时触发 不触发

Close方法示例代码

Sub CloseDocumentsSafely()
    ' 方案1: 保存并关闭当前文档
    CATIA.ActiveDocument.Close catSaveChanges

    ' 方案2: 批量关闭所有文档
    Dim i As Integer
    For i = CATIA.Documents.Count To 1 Step -1
        Dim doc As Document
        Set doc = CATIA.Documents.Item(i)
        
        ' 检查文档状态
        If doc.Saved Then
            doc.Close catDoNotSaveChanges
        Else
            ' 自定义保存逻辑
            If MsgBox("保存 " & doc.Name & " 的更改吗?", vbYesNo) = vbYes Then
                doc.Close catSaveChanges
            Else
                doc.Close catDoNotSaveChanges
            End If
        End If
    Next i
End Sub

Sub CloseNewDocument()
' 处理新建未保存文档
Dim newDoc As Document
Set newDoc = CATIA.Documents.Add("Part")

    ' 不保存直接关闭
    newDoc.Close catDoNotSaveChanges
    
    ' 或者带参数关闭(会弹出保存对话框)
    ' newDoc.Close
End Sub

Close方法最佳实践

' 安全关闭函数
Function SafeClose(doc As Document, saveOption As Integer) As Boolean
    On Error Resume Next
    doc.Close saveOption
    If Err.Number = 0 Then
        SafeClose = True
    Else
        SafeClose = False
        Debug.Print "关闭失败: " & doc.Name & " - " & Err.Description
    End If
    On Error GoTo 0
End Function

' 使用示例
If Not SafeClose(currentDoc, catSaveChanges) Then
    MsgBox "文档关闭失败,请手动关闭", vbExclamation
End If

Save方法示例代码

Sub AutoSaveDocuments()
    ' 每5分钟自动保存所有文档
    Dim doc As Document
    For Each doc In CATIA.Documents
        If Not doc.Saved Then
            ' 跳过只读文档
            If Not doc.ReadOnly Then
                On Error Resume Next
                doc.Save
                If Err.Number = 0 Then
                    LogAction "自动保存: " & doc.Name
                End If
                On Error GoTo 0
            End If
        End If
    Next
End Sub

Sub SaveWithBackup()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 1. 保存当前状态
    doc.Save
    
    ' 2. 创建备份
    Dim backupPath As String
    backupPath = doc.Path & "Backup_" & Format(Now, "yyyymmdd_hhmm") & "_" & doc.Name
    
    ' 3. 另存为备份
    doc.SaveAs backupPath
    
    ' 4. 关闭备份文档(保留原文档)
    CATIA.ActiveDocument.Close catDoNotSaveChanges
End Sub

Save方法最佳实践

' 增强保存函数
Function EnhancedSave(doc As Document) As Boolean
    ' 检查文档状态
    If doc.ReadOnly Then
        MsgBox "文档为只读模式,无法保存", vbExclamation
        EnhancedSave = False
        Exit Function
    End If
    
    ' 新建文档处理
    If InStr(doc.FullName, "Untitled") > 0 Then
        Dim savePath As String
        savePath = GetSavePath(doc.Type)  ' 自定义获取路径函数
        If savePath <> "" Then
            doc.SaveAs savePath
            EnhancedSave = True
        Else
            EnhancedSave = False
        End If
    Else
        On Error Resume Next
        doc.Save
        EnhancedSave = (Err.Number = 0)
        On Error GoTo 0
    End If
End Function

SaveAs方法示例代码

Sub ConvertToSTEP()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 设置STEP格式过滤器
    doc.CurrentFilter = "stp"
    
    ' 构建输出路径
    Dim exportPath As String
    exportPath = "C:Exports" & Replace(doc.Name, ".CATPart", ".stp")
    
    ' 执行另存为
    doc.SaveAs exportPath
    
    ' 关闭新打开的STEP文档
    CATIA.ActiveDocument.Close catDoNotSaveChanges
End Sub

Sub CreateDocumentVersion()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 生成版本文件名
    Dim versionPath As String
    versionPath = doc.Path & "Versions" & _
                 Replace(doc.Name, ".", "_v" & GetNextVersion() & ".")
    
    ' 保存新版本
    doc.SaveAs versionPath
    
    ' 记录版本信息
    LogVersion doc.Name, versionPath
End Sub

Function GetNextVersion() As Integer
    ' 实现版本计数逻辑
    Static version As Integer
    version = version + 1
    GetNextVersion = version
End Function

SaveAs方法最佳实践

' 安全另存为函数
Function SafeSaveAs(doc As Document, newPath As String, Optional format As String = "") As Boolean
    ' 备份当前过滤器
    Dim originalFilter As String
    originalFilter = doc.CurrentFilter
    
    ' 设置新格式(如果指定)
    If format <> "" Then
        doc.CurrentFilter = format
    End If
    
    On Error Resume Next
    doc.SaveAs newPath
    If Err.Number = 0 Then
        ' 恢复原始过滤器
        doc.CurrentFilter = originalFilter
        SafeSaveAs = True
    Else
        SafeSaveAs = False
        Debug.Print "另存为失败: " & Err.Description
    End If
    On Error GoTo 0
End Function

高级应用场景

场景一:自动化文档转换流水线

Sub ConvertAllPartsToSTEP()
    ' 禁用UI刷新
    CATIA.ScreenUpdating = False
    
    ' 遍历所有零件文档
    Dim doc As Document
    For Each doc In CATIA.Documents
        If doc.Type = "Part" Then
            ' 设置STEP过滤器
            doc.CurrentFilter = "stp"
            
            ' 构建输出路径
            Dim exportPath As String
            exportPath = "C:STEP_Output" & Replace(doc.Name, ".CATPart", ".stp")
            
            ' 另存为STEP
            doc.SaveAs exportPath
            
            ' 关闭新打开的STEP文档
            CATIA.ActiveDocument.Close catDoNotSaveChanges
        End If
    Next
    
    ' 恢复UI刷新
    CATIA.ScreenUpdating = True
    MsgBox "转换完成!", vbInformation
End Sub

场景二:带版本控制的保存系统

Sub SaveWithVersionControl()
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    ' 1. 保存当前文档
    doc.Save
    
    ' 2. 创建带时间戳的备份
    Dim timestamp As String
    timestamp = Format(Now, "yyyymmdd_hhnnss")
    
    Dim backupPath As String
    backupPath = doc.Path & "Backup" & Replace(doc.Name, ".", "_" & timestamp & ".")
    
    doc.SaveAs backupPath
    CATIA.ActiveDocument.Close catDoNotSaveChanges  ' 关闭备份
    
    ' 3. 更新版本历史
    UpdateVersionHistory doc, backupPath
End Sub

Sub UpdateVersionHistory(doc As Document, backupPath As String)
    ' 获取或创建版本参数
    Dim versionParam As Parameter
    On Error Resume Next
    Set versionParam = doc.Parameters.Item("VersionHistory")
    If versionParam Is Nothing Then
        Set versionParam = doc.Parameters.CreateString("VersionHistory", "")
    End If
    
    ' 添加新版本记录
    Dim history As String
    history = versionParam.Value
    history = history & vbCrLf & Now & " | " & backupPath
    
    ' 限制历史记录长度
    Dim lines As Variant
    lines = Split(history, vbCrLf)
    If UBound(lines) > 10 Then
        history = Join(SliceArray(lines, UBound(lines) - 9, UBound(lines)), vbCrLf)
    End If
    
    versionParam.Value = history
End Sub

场景三:文档处理工作流

Sub DocumentProcessingWorkflow()
    ' 1. 创建新文档
    Dim newDoc As Document
    Set newDoc = CATIA.Documents.Add("Part")
    newDoc.Activate
    
    ' 2. 设计零件
    CreateBaseFeature newDoc
    
    ' 3. 保存到工作目录
    newDoc.SaveAs "C:ProjectNewPart.CATPart"
    
    ' 4. 创建工程图
    Dim drawingDoc As Document
    Set drawingDoc = CATIA.Documents.Add("Drawing")
    drawingDoc.Activate
    CreateDrawing drawingDoc, newDoc
    
    ' 5. 保存工程图
    drawingDoc.SaveAs "C:ProjectNewPart_Drawing.CATDrawing"
    
    ' 6. 创建装配
    Dim assyDoc As Document
    Set assyDoc = CATIA.Documents.Add("Product")
    assyDoc.Activate
    AddComponent assyDoc, newDoc
    
    ' 7. 最终保存
    assyDoc.SaveAs "C:ProjectAssembly.CATProduct"
    
    ' 8. 清理临时文档
    newDoc.Close catSaveChanges
    drawingDoc.Close catSaveChanges
End Sub

最佳实践总结 通用原则
1、状态检查:操作前检查Saved和ReadOnly属性;2、错误处理:所有保存/关闭操作添加错误处理;3、资源清理:及时关闭不需要的文档;4、用户反馈:长时间操作提供进度提示。
Close 方法最佳实践

' 安全关闭模式
Sub SafeCloseDocument(doc As Document)
    Static attemptCount As Integer
    
    On Error Resume Next
    doc.Close catSaveChanges
    
    Select Case Err.Number
        Case 0: ' 成功关闭
        Case 438: ' 对象不支持属性或方法(文档已关闭)
        Case Else:
            attemptCount = attemptCount + 1
            If attemptCount < 3 Then
                MsgBox "关闭失败,重试中...", vbExclamation
                Application.Wait Now + TimeValue("00:00:01")
                SafeCloseDocument doc
            Else
                MsgBox "无法关闭文档: " & doc.Name, vbCritical
            End If
    End Select
    On Error GoTo 0
End Sub

Save 方法最佳实践

' 条件保存函数
Function ConditionalSave(doc As Document) As Boolean
    ' 检查是否需要保存
    If doc.Saved Or doc.ReadOnly Then
        ConditionalSave = False
        Exit Function
    End If
    
    ' 检查磁盘空间
    If FreeDiskSpace(doc.Path) < 100 Then ' 100MB
        MsgBox "磁盘空间不足,无法保存!", vbCritical
        ConditionalSave = False
        Exit Function
    End If
    
    ' 执行保存
    On Error Resume Next
    doc.Save
    ConditionalSave = (Err.Number = 0)
    On Error GoTo 0
End Function

SaveAs 方法最佳实践

' 智能另存为
Function SmartSaveAs(doc As Document, folderPath As String) As Boolean
    ' 生成唯一文件名
    Dim fileName As String
    fileName = GenerateUniqueName(doc.Name, folderPath)
    
    ' 保持原始格式
    Dim originalFilter As String
    originalFilter = doc.CurrentFilter
    
    ' 执行另存为
    On Error Resume Next
    doc.SaveAs folderPath & "" & fileName
    If Err.Number = 0 Then
        ' 关闭新文档,保留原文档
        CATIA.ActiveDocument.Close catDoNotSaveChanges
        SmartSaveAs = True
    Else
        SmartSaveAs = False
    End If
    
    ' 恢复原始过滤器
    doc.CurrentFilter = originalFilter
    On Error GoTo 0
End Function

Function GenerateUniqueName(baseName As String, folderPath As String) As String
    Dim i As Integer
    i = 1
    Dim newName As String
    newName = baseName
    
    Do While Len(Dir(folderPath & "" & newName)) > 0
        i = i + 1
        newName = Replace(baseName, ".", "_" & i & ".", , 1)
    Loop
    
    GenerateUniqueName = newName
End Function

常见问题解决方案

问题1:关闭文档时卡死 解决方案:异步关闭

Sub AsyncCloseDocument(doc As Document)
    ' 保存文档状态
    Dim docName As String
    docName = doc.Name
    
    ' 在新线程中关闭
    CreateThread "CloseDocThread", docName
End Sub

Sub CloseDocThread(docName As String)
    Dim doc As Document
    Set doc = GetDocumentByName(docName)
    If Not doc Is Nothing Then
        doc.Close catSaveChanges
    End If
End Sub

问题2:SaveAs后原文档引用失效 解决方案:重新获取引用

Sub SaveAsAndContinue()
    Dim originalDoc As Document
    Set originalDoc = CATIA.ActiveDocument
    Dim originalName As String
    originalName = originalDoc.FullName

    ' 执行另存为
    originalDoc.SaveAs "C:NewVersion.CATPart"
    
    ' 重新获取原文档
    Set originalDoc = GetDocumentByPath(originalName)
    
    ' 继续操作原文档
    originalDoc.Activate
End Sub

问题3:批量保存性能优化 解决方案:并行处理

Sub BatchSaveOptimized()
    ' 创建文档队列
    Dim docQueue As Collection
    Set docQueue = New Collection
    
        ' 填充队列
        Dim doc As Document
        For Each doc In CATIA.Documents
            If Not doc.Saved Then
                docQueue.Add doc
            End If
        Next
        
        ' 并行保存(伪代码)
        Dim i As Integer
        For i = 1 To docQueue.Count
            StartAsyncTask "SaveDocumentTask", docQueue(i)
        Next
        
        ' 等待所有任务完成
        WaitForAllTasks
    End Sub
    
    Sub SaveDocumentTask(doc As Document)
    On Error Resume Next
    doc.Save
    If Err.Number <> 0 Then
    LogError "保存失败: " & doc.Name & " - " & Err.Description
    End If
    On Error GoTo 0
End Sub

总结
掌握 Close、Save 和 SaveAs 方法的深度应用,可以实现:

健壮的文档生命周期管理
高效的文件操作工作流
自动化的版本控制系统
可靠的批量处理解决方案
用户友好的数据持久化策略
这些方法虽然基础,但正确使用它们对于构建专业级 CATIA 自动化解决方案至关重要。

上述部分代码有的未经各个版本测试,在参考使用时应经过再次调试。


推荐阅读:阅读本文请参考以下文章

001、【CATIA的二次开发01】技术与原理

002、【CATIA的二次开发02】CATIA对象结构图

003、【CATIA的二次开发03】零件设计工作台对象结构及应用

004、【CATIA的二次开发04】错误处理技巧

005、【CATIA的二次开发05】装配设计对象结构及应用

006、【CATIA的二次开发06】创成式曲面设计对象结构及应用

007、【CATIA的二次开发07】草图编辑器对象结构及应用

008、【CATIA的二次开发08】工程制图对象结构及应用

009、【CATIA的二次开发09】Collection、Abstract Object和Object区别

010、【CATIA的二次开发10】CATIA版本发展历程及其在VBA开发中相关背景

011、【CATIA的二次开发11】CATIA V5对象层次结构

012、【CATIA的二次开发12】根对象Application的Documents集合概述

013、【CATIA的二次开发13】根对象Application的Documents集合方法

014、【CATIA的二次开发14】根对象Application的Documents集合属性

015、【CATIA的二次开发15】根对象Application的Documents集合方法

016、【CATIA的二次开发16】根对象Application涉及撤销和重做事务管理相关方法

017、【CATIA的二次开发17】根对象Application涉及文档与文件操作相关方法

018、【CATIA的二次开发18】根对象Application涉及用户交互相关方法

019、【CATIA的二次开发19】根对象Application涉及对象与集合及邮件相关方法

020、【CATIA的二次开发20】根对象Application常用属性(ActiveDocument属性Caption属性Name属性)

021、【CATIA的二次开发21】根对象Application常用属性(StatusBar属性RefreshDisplay属性Application属性)

022、【CATIA的二次开发22】关于抽象对象Document概念详细总结

023、【CATIA的二次开发23】抽象对象Document涉及文档激活控制的方法


感谢已关注! 🙏 很高兴您的阅读、已关注、收藏与支持!我会继续努力学习,持续分享我在学习编程过程中的一点经验,希望能为大家带来帮助。 如果有任何问题或建议,欢迎随时留言交流!一起学习,共同进步!💻🚀

© 版权声明
THE END
如果内容对您有所帮助,就支持一下吧!
点赞0 分享
评论 抢沙发

请登录后发表评论

    暂无评论内容