求助：编写Catia屏幕捕获250×250像素图片至剪贴板的宏代码

嘿，正好帮你补上这块屏幕捕获的代码！你已经搞定了视角定位，接下来只需要借助Windows API来实现屏幕区域捕获和剪贴板复制——毕竟VBA本身没有直接的这类功能，直接上代码和解释：

第一步：添加API声明和结构体（必须放在模块顶部） #

这些是调用Windows底层图形和剪贴板功能的必备声明，要放在你的宏模块最开头，不能放在子程序里面：

' Windows API 声明，兼容32/64位CATIA/Office
Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As LongPtr) As LongPtr
Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long

' 存储窗口坐标的结构体
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

' 常量定义
Const SRCCOPY = &HCC0020  ' 直接复制像素的操作码
Const CF_BITMAP = 2       ' 剪贴板的位图格式

第二步：整合你的视角代码和捕获逻辑 #

把下面的子程序和你已有的代码结合起来，核心是获取Viewer3D的位置，捕获居中的250×250区域，然后复制到剪贴板：

Sub CaptureCATIAViewToClipboard()
    Dim objViewer3D As Viewer3D
    Dim viewerHwnd As LongPtr
    Dim viewerRect As RECT
    Dim srcDC As LongPtr
    Dim destDC As LongPtr
    Dim hBitmap As LongPtr
    Dim captureWidth As Long, captureHeight As Long
    
    ' --- 你已有的视角定位代码 ---
    Selection1.Search("Name=" + TextBox1.Value + "*,all")
    Catia.StartCommand("reframe On")
    Catia.RefreshDisplay = True
    Set objViewer3D = Catia.ActiveWindow.ActiveViewer
    objViewer3D.Viewpoint3D.Zoom = 0.8 ' 这里按你的需求调整缩放值
    
    ' --- 新增的屏幕捕获+剪贴板逻辑 ---
    ' 设置要捕获的尺寸：250x250像素
    captureWidth = 250
    captureHeight = 250
    
    ' 获取Viewer3D的窗口句柄和屏幕坐标
    viewerHwnd = objViewer3D.Hwnd
    GetWindowRect viewerHwnd, viewerRect
    
    ' 计算居中的捕获区域（避免只截到边角，更合理）
    Dim captureLeft As Long, captureTop As Long
    captureLeft = viewerRect.Left + (viewerRect.Right - viewerRect.Left - captureWidth) / 2
    captureTop = viewerRect.Top + (viewerRect.Bottom - viewerRect.Top - captureHeight) / 2
    
    ' 创建兼容的图形设备上下文（DC）和位图
    srcDC = GetDC(0) ' 获取整个屏幕的DC
    destDC = CreateCompatibleDC(srcDC)
    hBitmap = CreateCompatibleBitmap(srcDC, captureWidth, captureHeight)
    SelectObject destDC, hBitmap
    
    ' 把屏幕上指定区域的图像复制到位图
    BitBlt destDC, 0, 0, captureWidth, captureHeight, srcDC, captureLeft, captureTop, SRCCOPY
    
    ' 将位图写入剪贴板
    OpenClipboard 0
    EmptyClipboard
    SetClipboardData CF_BITMAP, hBitmap
    CloseClipboard
    
    ' 释放所有占用的系统资源（必须做，避免内存泄漏）
    DeleteDC destDC
    ReleaseDC 0, srcDC
    DeleteObject hBitmap
    
    MsgBox "已成功捕获250×250的CATIA视图并复制到剪贴板！"
End Sub

关键细节说明 #

• 居中捕获：代码里计算了Viewer3D窗口的中心区域来捕获，这样不管Viewer多大，都能拿到视图的核心部分；如果需要捕获左上角区域，直接把captureLeft和captureTop改成viewerRect.Left和viewerRect.Top就行。
• 资源释放：所有创建的DC、位图必须手动释放，不然会导致系统内存泄漏。
• 兼容性：用了PtrSafe声明，兼容64位的CATIA和Office，如果你用的是32位版本，可以去掉PtrSafe和LongPtr换成Long。

现在你运行这个宏，就能把CATIA视图的250×250图像复制到剪贴板，之后直接在Excel里粘贴就搞定啦！

内容的提问来源于stack exchange，提问作者Aatrox The Darkin Blade