如何通过Inventor VBA一键导出白色背景图片？

以下是符合需求的VBA代码，可实现临时切换白色背景导出图片后自动恢复原深色背景：

Sub ExportWhiteBackgroundImage()
    Dim invApp As Inventor.Application
    Dim activeDoc As Inventor.Document
    Dim activeView As Inventor.View
    Dim originalBackgroundColor As Color
    Dim exportOptions As ImageExportOptions
    Dim desktopPath As String
    Dim exportFileName As String
    
    ' 获取Inventor应用实例
    Set invApp = GetObject(, "Inventor.Application")
    
    ' 检查是否有活动文档
    If invApp.ActiveDocument Is Nothing Then
        MsgBox "请先打开一个Inventor文档！", vbExclamation
        Exit Sub
    End If
    
    Set activeDoc = invApp.ActiveDocument
    Set activeView = activeDoc.ActiveView
    
    ' 保存当前背景颜色
    Set originalBackgroundColor = activeView.BackgroundColor
    
    On Error GoTo ErrorHandler ' 确保出错时也能恢复背景
    
    ' 将视图背景切换为白色
    activeView.BackgroundColor = invApp.TransientObjects.CreateColor(255, 255, 255)
    
    ' 获取系统桌面路径
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    ' 预设导出文件名，可自行修改名称和格式
    exportFileName = desktopPath & "\Inventor视图导出.png"
    
    ' 配置导出参数
    Set exportOptions = invApp.Application.CreateImageExportOptions(exportFileName, activeView)
    exportOptions.Resolution = 300 ' 导出分辨率，可按需调整
    exportOptions.ExportRange = kExportActiveView ' 仅导出当前活动视图
    
    ' 执行导出
    activeDoc.Export exportOptions
    
    MsgBox "图片已导出到桌面：" & exportFileName, vbInformation

ErrorHandler:
    ' 恢复原有背景颜色
    activeView.BackgroundColor = originalBackgroundColor
    If Err.Number <> 0 Then
        MsgBox "导出出错：" & Err.Description, vbCritical
    End If
    
    ' 释放对象资源
    Set exportOptions = Nothing
    Set activeView = Nothing
    Set activeDoc = Nothing
    Set invApp = Nothing
End Sub

使用说明 #

• 1. 打开Inventor文档，调整好主视图的角度和距离
• 2. 按Alt+F11打开VBA编辑器，插入新模块并粘贴上述代码
• 3. 保存宏后，可将该宏添加到Inventor的快速访问工具栏，点击即可一键执行
• 4. 可自行修改代码中的exportFileName调整导出文件名/格式，或修改Resolution调整图片清晰度

内容的提问来源于stack exchange，提问作者Gilles D'Hoker