[CATIA] Interactive macro for Screen shot.

[siddhu2310]

Hi Everyone,

Let say I have four components in the CATPart File.
I need to take screen shot automatically with White background, The view should user need to rotate manually.
Parts:
A
B
C
D
If Macro, ask for the components to display , I will choose B & C then click for camera , I need set the view manually , once I click okay will need to take screen shot.

 

[PedroPeter]

Try this:

Sub CaptureScreenshot()
Dim CATIA As Object
Set CATIA = GetObject(, "CATIA.Application")

If CATIA Is Nothing Then
MsgBox "CATIA is not running. Please start CATIA and try again."
Exit Sub
End If

Dim doc As Object
Set doc = CATIA.ActiveDocument

If Not doc Is Nothing Then
Dim selection As Object
Set selection = doc.Selection

' Prompt user to select components to display
MsgBox "Please select the components to display and set the desired view manually. Then click OK to capture the screenshot."

selection.Clear
selection.Search "Select the components to display", "CATPart"

' Capture the screenshot
doc.ExportImage "C:\Path\To\Save\The\Screenshot.jpg", "image/jpeg", 100, 100, 100, 3

MsgBox "Screenshot captured successfully!"
Else
MsgBox "No active document found. Please open a CATPart file and try again."
End If

Set CATIA = Nothing
End Sub

Modify the file path in the line doc.ExportImage "C:\Path\To\Save\The\Screenshot.jpg", "image/jpeg", 100, 100, 100, 3 to specify the location where you want to save the screenshot.

 

[siddhu2310]

i'm getting error on the yellow line

i'm using CATIA V5

 

[PedroPeter]

Sorry I can't test it right now.
Try this:

Sub CaptureViewport(strFileName As String, Optional intWidth As Integer = 1024, Optional intHeight As Integer = 1024)
    Dim objWindow As SpecsAndGeomWindow
    Dim objViewer As Variant ' Viewer3D
    Dim objCamera As Camera3D
    Dim objViewpoint As Variant ' Viewpoint3D
    Dim arrOldBackgroundColor(2) As Variant
    Dim intOldRenderingMode As CatRenderingMode
    Dim intOldLayout As CatSpecsAndGeomWindowLayout

    Set objWindow = CATIA.ActiveWindow
    Set objCamera = CATIA.ActiveDocument.Cameras.Item(1)
    Set objViewer = objWindow.ActiveViewer
    Set objViewpoint = objViewer.Viewpoint3D

    objViewer.GetBackgroundColor arrOldBackgroundColor
    intOldRenderingMode = objViewer.RenderingMode
    intOldLayout = objWindow.Layout
    ' This might be extended to record the old window dimensions as well

    objViewer.FullScreen = False
    objViewer.PutBackgroundColor Array(1, 1, 1) ' White
    objViewer.RenderingMode = catRenderShadingWithEdges
    objWindow.Layout = catWindowGeomOnly
    objWindow.Width = intWidth
    objWindow.Height = intHeight

    objViewpoint.PutSightDirection Array(-1, -1, -1) ' Isometric
    objViewpoint.PutUpDirection Array(0, 0, 1)
    objViewpoint.ProjectionMode = catProjectionCylindric ' Parallel projection
    objViewer.Reframe

    ' Without this, the picture is not always sized correctly
    CATIA.RefreshDisplay = True
    objViewer.Update
    objViewer.CaptureToFile catCaptureFormatBMP, strFileName
    CATIA.RefreshDisplay = False

    objViewer.PutBackgroundColor arrOldBackgroundColor
    objViewer.RenderingMode = intOldRenderingMode
    objWindow.Layout = intOldLayout
    ' This might be extended to restore the old window dimensions as well
End Sub

or try the free vba app available online called TAKE_PIC.

 

[PedroPeter]

Or you could try the Emmett Ross one:

Sub CATMain()
    Dim ObjViewer3D As Viewer3D
    Set objViewer3D = CATIA.ActiveWindow.ActiveViewer

    Dim objCamera3D As Camera3D
    Set objCamera3D = CATIA.ActiveDocument.Cameras.Item(1)

    ' Input box to name the screen capture image file
    Dim partName As String
    partName = InputBox("Please name the image.")

    If partName = "" Then
        MsgBox "No name was entered. Operation aborted.", vbExclamation, "Cancel"
    Else
        ' Turn off the spec tree
        Dim objSpecWindow As SpecsAndGeomWindow
        Set objSpecWindow = CATIA.ActiveWindow
        objSpecWindow.Layout = catWindowGeomOnly

        ' Toggle Compass
        CATIA.StartCommand("Compass")

        ' Change background color to white
        Dim dblBackArray(2)
        objViewer3D.GetBackgroundColor(dblBackArray)

        Dim dblWhiteArray(2)
        dblWhiteArray(0) = 1
        dblWhiteArray(1) = 1
        dblWhiteArray(2) = 1
        objViewer3D.PutBackgroundColor(dblWhiteArray)

        ' File location to save image
        Dim fileloc As String
        fileloc = "C:\User\Macro Files\"

        Dim exten As String
        exten = ".png"

        Dim strName As String
        strName = fileloc & partName & exten

        If MsgBox("To reframe and automatically switch to ISO view click Yes. To take the image as shown on screen click No.", vbYesNo) = vbYes Then
            objViewer3D.Viewpoint3D = objCamera3D.Viewpoint3D

            ' Reframe
            objViewer3D.Reframe()

            ' Zoom in
            objViewer3D.ZoomIn()

            ' Clear selection for picture
            CATIA.ActiveDocument.Selection.Clear()

            ' Increase to fullscreen to obtain maximum resolution
            objViewer3D.FullScreen = True

            ' Take picture with auto ISO view and reframe ON
            objViewer3D.CaptureToFile 4, strName
        Else
            ' Take picture as is with NO reframe or iso view
            ' Zoom in
            ' objViewer3D.ZoomIn()

            ' Clear selection for picture
            CATIA.ActiveDocument.Selection.Clear()

            ' Increase to fullscreen to obtain maximum resolution
            objViewer3D.FullScreen = True

            ' Take picture
            objViewer3D.CaptureToFile 4, strName
        End If

        ' Reset
        objViewer3D.FullScreen = False
        objViewer3D.PutBackgroundColor(dblBackArray)
        objSpecWindow.Layout = catWindowSpecsAndGeom
        CATIA.StartCommand("Compass")
    End If
End Sub