Catia image capturing 1

[Rakeshgs073]

Hello,
When i capture an image and copy it to ppt a hairline border is showing.how can solve this issue can anyone help me

 

[jackk]

You do have the imported picture set to NO BORDER in PowerPoint - right?

I don't recall having this problem in the past. I would set my CATIA image capture options to White Background, and often would make the background transparent after pasting the image into PowerPoint.

 

[TiagoFigueiredo]

Let me try to help you

This is the code to extract the image scree from catia

    Public Sub Take_Picture()


        Dim documents1 = CATIA.Documents

        CATIA.DisplayFileAlerts = False
        documents1 = CATIA.Documents
        Dim productDocument1 = CATIA.ActiveDocument
        Produto = productDocument1.Name
        ObjViewer3D = CATIA.ActiveWindow.ActiveViewer

        objCamera3D = CATIA.ActiveDocument.Cameras.Item(1)

        'selecção
        selection1 = productDocument1.Selection
        'selection1.clear
        Dim time As DateTime = DateTime.Now.ToString("d")
        Dim time1 = Replace(time, ":", ".")
        Dim time2 = Replace(time1, "/", "-")
        Dim partname = Produto & " - " & time2
        'turn off the spec tree
        CATIA.Visible = True
        CATIA.StartCommand("Specifications")

        '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

        fileloc = "C:\CATIA Files\"
        Dim exten As String
        exten = ".png"

        strName = fileloc & partname & exten

        'increase to fullscreen to obtain maximum resolution
        ObjViewer3D.FullScreen = True

        'take picture
        ObjViewer3D.CaptureToFile(CatCaptureFormat.catCaptureFormatBMP, strName)

        '*******************RESET**********************
        ObjViewer3D.FullScreen = False
        'change background color back
        ObjViewer3D.PutBackgroundColor(DBLBackArray)
        'turn on tree
        CATIA.StartCommand("Specifications")
        'toggle compass
        CATIA.StartCommand("Compass")

    End Sub

to insert in ppt

On Error Resume Next
            User = Environment.UserName

          
            Call Take_image_app.Get_file_properties()
            Dim PPT As Object

            Dim c = 0

            Dim myDocument


            PPT = GetObject(, "PowerPoint.Application")

            c = PPT.presentations.count

            If c > 1 Then
                MsgBox("Foram encontrada mais que uma apresentação aberta, as mesmas serão fechadas")
                For i = PPT.Presentations.Count To 1 Step -1
                    PPT.presentations.item(i).close()
                Next
                Open_PPT_Template()
            End If


            If c = 0 Then
                Open_PPT_Template()
            End If


            PPT = GetObject(, "PowerPoint.Application")


            ''''''''''''''''''''''''''VAI DUPLICAR O SLIDE À APRESENTAÇÃO
            Dim uNewS = PPT.ActivePresentation.Slides(PPT.ActivePresentation.slides.count - 1).Duplicate

            ''''''''''''''''''''''''''VAI ADICIONAR A IMAGEM AO SLIDE ANTERIOR AO DUPLICADO
            myDocument = PPT.ActivePresentation.Slides(PPT.ActivePresentation.slides.count - 2)
            myDocument.Shapes.AddPicture(strName, False, True, 30, 180, 660, 340)





            ''''''''''''''''''''''''''VAI SUBSTITUIR A INFORMAÇÃO QUE VEM NAS CAIXAS DE TEXTO

            With myDocument.Shapes.Item(5).TextFrame.TextRange
                .Text = "PN: " & Part_Name
                .Font.Name = "Calibri (Body)"
                .Font.Size = 16
            End With

            With myDocument.Shapes.Item(2).TextFrame.TextRange
                .Text = "DESC: " & Description & "    " & "MAT: " & Material & "    T. TÉRMICO:" & T_Termico & "    T.SUP:" & T_Superficial & "    DIM:" & Dimensions
                .Font.Name = "Calibri (Body)"
                .Font.Size = 16
            End With

            With myDocument.Shapes.Item(4).TextFrame.TextRange
                .Text = "COMENTÁRIOS: " & TextBox1.Text
                .Font.Name = "Calibri (Body)"
                .Font.Size = 16
            End With

            With myDocument.Shapes.Item(6).TextFrame.TextRange
                .Text = "RESPONSÁVEL: " & User
                .Font.Name = "Calibri (Body)"
                .Font.Size = 12
            End With
            PPT.visible = True
            IO.File.Delete(strName)

With this code, is supposed to have oppen an ppt file, and every time that macro run, it copies the penultimate slide of the presentation. Hope it helps.



Tiago Figueiredo
Tooling Engineer

Youtube channel:

https://www.youtube.com/channel/UC1qdlBeJJEgMgpPLVJoOIOw