Exporting Screenshot to PowerPoint

Hi I am taking NX standard views and export to them to a PPT in standard format, I am facing problem with the scale. The view scale is not aligned to each other due to the capture size and fit view (Width and Height is not same when the image is compressed to standard size, View fit is also causing the issue). Is that possible to Make the capture area square and Properly fit, so the views will look aligned. Will this one will help me to define the frame "ufs.Disp.CreateFramedImage"? for this what has to be the upleftcorner value

Option Strict Off
Imports System
Imports System.IO
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Collections
Imports System.Runtime.InteropServices
Imports NXOpen
Imports NXOpen.GeometricUtilities
Imports NXOpen.UF
Imports NXOpen.Assemblies
Imports NXOpenUI
Imports System.Collections.Generic
Imports System.Threading
Imports Microsoft.Office
Imports Microsoft.Office.Interop.PowerPoint
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel

Module OnePagerToolNX

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
Dim theUI As UI = UI.GetUI
Dim ufs As UFSession = UFSession.GetUFSession
Dim lw As ListingWindow = theSession.ListingWindow
'Dim AppPowerPoint As PowerPoint.Application = Nothing
'Dim ActiveSlide As PowerPoint.Slide = Nothing
'Dim ActivePresentation As PowerPoint.Presentation = Nothing
Dim AppPowerPoint As Object = Nothing ' NX Doesnot support Powerpoint or Office Objects
Dim ActiveSlide As Object = Nothing
Dim ActivePresentation As Object = Nothing
Dim RefFileName As String = Nothing
Dim RefPresentation As Object = Nothing
Dim RefSlide As Object = Nothing
Dim ModelParts As New ArrayList
Dim AssyParts As New ArrayList
Dim MyPart As Part = Nothing
Dim PowerpointFileName As String = Nothing
Dim PowerpointFileExists As Boolean = False
Dim basePart1 As BasePart = Nothing
Dim allParts() As Part = Nothing

Sub Main()

lw.Open()

Dim ParentPartNo As String = Nothing
Dim ParentPartRev As String = Nothing
Dim ParentPartName As String = Nothing
Dim CurrentDate As String = System.DateTime.Today
ParentPartNo = "X" 'workPart.GetStringAttribute("DB_PART_NO")
ParentPartRev = "Y" 'workPart.GetStringAttribute("DB_PART_REV")
ParentPartName = "Z" 'workPart.GetStringAttribute("DB_PART_NAME")

'Create Powerpoint File and Save it in user defined location
Dim SaveFileDialog1 As New SaveFileDialog
With SaveFileDialog1
.Title = "Save OnePager to Presentation File"
.InitialDirectory = "C:\"
.Filter = "PowerpointFiles (*.pptx)|*.pptx|Macro enabled Powerpoint files (*.pptm)|*.pptm|All files (*.*)|*.*"
.FilterIndex = 1
.RestoreDirectory = True
.OverwritePrompt = False
.FileName = ParentPartNo & "- One Pager Presentation"
If .ShowDialog() = DialogResult.OK Then
PowerpointFileName = .FileName
Else
Exit Sub
End If
End With

If AppPowerPoint Is Nothing Then
AppPowerPoint = CreateObject("PowerPoint.Application")

If AppPowerPoint Is Nothing Then
theUI.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not start Powerpoint, journal exiting")
Exit Sub
End If
End If

AppPowerPoint.Visible = True

If File.Exists(PowerpointFileName) Then
PowerpointFileExists = True
ActiveSlide = AppPowerPoint.Presentations.Open(PowerpointFileName)
Else
ActivePresentation = AppPowerPoint.Presentations.Add()
ActivePresentation.SaveAs(PowerpointFileName)
End If

If ActivePresentation Is Nothing Then
theUI.NXMessageBox.Show("Error", NXMessageBox.DialogType.Error, "Could not open Powerpoint file: " & PowerpointFileName & ControlChars.NewLine & "journal exiting.")
Exit Sub
End If

RefPresentation = AppPowerPoint.Presentations.Open("C:\MyTemplate.pptx")

For i As Integer = 1 To RefPresentation.Slides.Count
RefPresentation.Slides.Item(i).Copy()
ActivePresentation.Slides.Paste()
'ActivePresentation.Slides.Item(i).Design = RefPresentation.Slides.Item(i).Design()
Next i
RefPresentation.Close()

Dim Titlebox As Object = Nothing
Dim DateBox As Object = Nothing

Titlebox = ActivePresentation.slides(1).Shapes.AddTextbox(1, 20, 150, 400, 30)
With Titlebox.TextFrame.TextRange
.Text = ParentPartNo & "/" & ParentPartRev & " : " & ParentPartName
.Font.Bold = True
.Font.Name = "Times New Roman"
.Font.Size = 15
End With

DateBox = ActivePresentation.slides(1).Shapes.AddTextbox(1, 20, 260, 150, 15)
With DateBox.TextFrame.TextRange
.Text = CurrentDate.ToString
.Font.Bold = False
.Font.Name = "Times New Roman"
.Font.Size = 11
End With

'Categorize Assembly and Parts in the current session
allParts = theSession.Parts.ToArray()
For Each Part1 As Part In allParts
Dim thisTag As NXOpen.Tag = ufs.Assem.AskRootPartOcc(Part1.Tag)
If thisTag = NXOpen.Tag.Null Then
ModelParts.Add(Part1)
Else
AssyParts.Add(Part1)
End If
Next

'Export all Parts Detail to Powerpoint

For Each Part2 As Part In AssyParts
MyPart = Part2
Call CreatePPT()
Next

For Each Part3 As Part In ModelParts
MyPart = Part3
Call CreatePPT()
Next

'ActivePresentation.Slides(2).Delete()
ActivePresentation.Save()
ActivePresentation.Close()
AppPowerPoint.Quit()
AppPowerPoint = Nothing
ActivePresentation = Nothing
ActiveSlide = Nothing

End Sub
Sub CreatePPT()

Dim Partno As String = Nothing

Dim MyPartLoadStatus As PartLoadStatus = Nothing
Dim SDPSstatus As PartCollection.SdpsStatus = Nothing
SDPSstatus = theSession.Parts.SetDisplay(MyPart, False, False, MyPartLoadStatus)
Dim tempScreenshot As String
Dim tempLocation As String = "C:\Temp"

'Getting Part Attributes
Try
Partno = MyPart.GetStringAttribute("DB_PART_NO")
Catch ex As NXException
lw.WriteLine("Partno Not found" & ex.ErrorCode & ":" & ex.Message.ToString)
Partno = "Not Found"
End Try

'Capture Views
Dim Mylayout As Layout = Nothing
'Hide unwanted Items in View
Dim visibleObjects() As DisplayableObject = Nothing
Try
Mylayout = CType(MyPart.Layouts.FindObject("L1"), Layout)
Const OtheritemLayer As Integer = 6
'Const Solidlayer As Integer = 1
Dim Isoview As ModelingView = CType(MyPart.ModelingViews.FindObject("Isometric"), ModelingView)
Mylayout.ReplaceView(MyPart.ModelingViews.WorkView, Isoview, True)
visibleObjects = MyPart.ModelingViews.WorkView.AskVisibleObjects()
For Each Obj As DisplayableObject In visibleObjects
If TypeOf (Obj) Is DatumPlane Then
Obj.Layer = OtheritemLayer
Obj.RedisplayObject()
End If
If TypeOf (Obj) Is CoordinateSystem Then
Obj.Layer = OtheritemLayer
Obj.RedisplayObject()
End If
If TypeOf (Obj) Is DatumAxis Then
Obj.Layer = OtheritemLayer
Obj.RedisplayObject()
End If
If TypeOf (Obj) Is Curve Then
Obj.Layer = OtheritemLayer
Obj.RedisplayObject()
End If

If TypeOf (Obj) Is Sketch Then
Obj.Layer = OtheritemLayer
Obj.RedisplayObject()
End If

Next
MyPart.Layers.SetState(1, Layer.State.WorkLayer)
MyPart.Layers.SetState(6, Layer.State.Hidden)
Catch ex As NXException
lw.WriteLine(Partno & ": Layers are not correct Please Check Image-" & ex.ErrorCode & ":" & ex.Message.ToString)
End Try

Try
Dim currentScale As Double = workPart.ModelingViews.WorkView.Scale
workPart.ModelingViews.WorkView.Fit()
workPart.ModelingViews.WorkView.SetScale(currentScale)
Catch ex As Exception
lw.WriteLine(Partno & ex.Message.ToString & "View Scale failed")
End Try
Try
Dim Isoview As ModelingView = CType(MyPart.ModelingViews.FindObject("Isometric"), ModelingView)
Mylayout.ReplaceView(MyPart.ModelingViews.WorkView, Isoview, True)
MyPart.ModelingViews.WorkView.RenderingStyle = NXOpen.View.RenderingStyleType.ShadedWithEdges
tempScreenshot = IO.Path.Combine(tempLocation, Partno & "- ISO.jpg")
ExportScreenshot(tempScreenshot)

Catch ex As NXException
lw.WriteLine(Partno & ": ISO View Not Generated-" & ex.ErrorCode & ":" & ex.Message.ToString)
End Try
'Capture Front View
Try
Dim Frontview As ModelingView = CType(MyPart.ModelingViews.FindObject("Front"), ModelingView)
Mylayout.ReplaceView(MyPart.ModelingViews.WorkView, Frontview, True)
MyPart.ModelingViews.WorkView.RenderingStyle = NXOpen.View.RenderingStyleType.ShadedWithEdges
tempScreenshot = IO.Path.Combine(tempLocation, Partno & "- Front.jpg")
ExportScreenshot(tempScreenshot)

Catch ex As NXException
lw.WriteLine(Partno & ": Front View Not Generated-" & ex.ErrorCode & ":" & ex.Message.ToString)
End Try

'Capture Left View
Try
Dim Leftview As ModelingView = CType(MyPart.ModelingViews.FindObject("Left"), ModelingView)
Mylayout.ReplaceView(MyPart.ModelingViews.WorkView, Leftview, True)
MyPart.ModelingViews.WorkView.RenderingStyle = NXOpen.View.RenderingStyleType.ShadedWithEdges
tempScreenshot = IO.Path.Combine(tempLocation, Partno & "- Left.jpg")
ExportScreenshot(tempScreenshot)

Catch ex As NXException
lw.WriteLine(Partno & ": Left View Not Generated-" & ex.ErrorCode & ":" & ex.Message.ToString)
End Try

'Capture Top View
Try
Dim Topview As ModelingView = CType(MyPart.ModelingViews.FindObject("Top"), ModelingView)
Mylayout.ReplaceView(MyPart.ModelingViews.WorkView, Topview, True)
MyPart.ModelingViews.WorkView.RenderingStyle = NXOpen.View.RenderingStyleType.ShadedWithEdges
tempScreenshot = IO.Path.Combine(tempLocation, Partno & "- Top.jpg")
ExportScreenshot(tempScreenshot)

Catch ex As NXException
lw.WriteLine(Partno & ": Top View Not Generated-" & ex.ErrorCode & ":" & ex.Message.ToString)
End Try

AppPowerPoint.ActivePresentation.Slides.AddSlide(AppPowerPoint.ActivePresentation.Slides.Count + 1, AppPowerPoint.ActivePresentation.SlideMaster.CustomLayouts(7))
AppPowerPoint.ActiveWindow.View.GotoSlide(AppPowerPoint.ActivePresentation.Slides.Count)
ActiveSlide = AppPowerPoint.ActivePresentation.Slides(AppPowerPoint.ActivePresentation.Slides.Count)
'Adding Images from Temporary Location
Try
ActiveSlide.Shapes.AddPicture(tempLocation & "\" & Partno & "- ISO.jpg", False, True, 40, 60, 200, 200)
ActiveSlide.Shapes.AddPicture(tempLocation & "\" & Partno & "- Left.jpg", False, True, 40, 280, 200, 200)
ActiveSlide.Shapes.AddPicture(tempLocation & "\" & Partno & "- Top.jpg", False, True, 280, 60, 200, 200)
ActiveSlide.Shapes.AddPicture(tempLocation & "\" & Partno & "- Front.jpg", False, True, 280, 280, 200, 200)
Catch ex As Exception
lw.WriteLine(Partno & ": Image Not added-" & ex.Message.ToString)
End Try

For Each Myshape As Object In ActiveSlide.Shapes
Myshape.Select()
Myshape.Line.Transparency = 1
Myshape.Line.Weight = 1
Myshape.Line.Visible = 1
Next

End Sub

Sub ExportScreenshot(ByVal filename As String)

'save user preference for visibility of WCS, triad, view name, and view border
Dim wcsVisible As Boolean = theSession.Parts.BaseDisplay.WCS.Visibility
Dim triadVisible As Integer = theSession.Preferences.ScreenVisualization.TriadVisibility
Dim displayModelViewNames As Boolean = theSession.Parts.BaseDisplay.Preferences.NamesBorderVisualization.ShowModelViewNames
Dim displayModelViewBorders As Boolean = theSession.Parts.BaseDisplay.Preferences.NamesBorderVisualization.ShowModelViewBorders

'turn off the WCS, triad, view name, and view border
theSession.Parts.BaseDisplay.WCS.Visibility = False
theSession.Preferences.ScreenVisualization.TriadVisibility = True
theSession.Parts.BaseDisplay.Preferences.NamesBorderVisualization.ShowModelViewBorders = False
theSession.Parts.BaseDisplay.Preferences.NamesBorderVisualization.ShowModelViewNames = False

Try
ufs.Disp.CreateImage(filename, UFDisp.ImageFormat.Jpeg, UFDisp.BackgroundColor.White)
'Dim Upleftcorner() As Integer = Nothing
'Upleftcorner(0) = 0
'Upleftcorner(1) = 0
'ufs.Disp.CreateFramedImage(filename, UFDisp.ImageFormat.Jpeg, UFDisp.BackgroundColor.White, Upleftcorner, 200, 200)
Catch ex As Exception
MsgBox(ex.Message & ControlChars.NewLine & _
"'" & filename & "' could not be created")
Throw New Exception("Screenshot could not be created")
Finally
'reset visibility of WCS, triad, view name, and view border to user's preference
theSession.Parts.BaseDisplay.WCS.Visibility = wcsVisible
theSession.Preferences.ScreenVisualization.TriadVisibility = triadVisible
theSession.Parts.BaseDisplay.Preferences.NamesBorderVisualization.ShowModelViewBorders = displayModelViewBorders
theSession.Parts.BaseDisplay.Preferences.NamesBorderVisualization.ShowModelViewNames = displayModelViewNames
End Try

End Sub

Public Function GetUnloadOption(ByVal dummy As String) As Integer
'Unloads the image immediately after execution within NX
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately

End Function

End Module