(API) Command VBA Projection Capture of a view

[Stephane.kapetanovic]

A copy of a popular discussion thread from 2011.

[Stephane.kapetanovic]

next msg

Public Sub CreeVueRM()
' définition d'une vue

robapp.Interactive = True
robapp.Visible = True
robapp.Window.Activate


robapp.Project.CalcEngine.Calculate ' calculate model

 

Dim mavueRobot As IRobotView3 ' this is important to set IRobotView3 if you want to make screen capture of this view

Set mavueRobot = robapp.Project.ViewMngr.GetView(1) ' it seems CreateView makes this strange affect, use GetView instead

mavueRobot.Selection.Get(I_OT_CASE).FromText ("3") ' selecting case for results display
mavueRobot.Redraw (True)

mavueRobot.Projection = I_VP_3DXYZ

' displaying map
mavueRobot.ParamsFeMap.CurrentResult = I_VFMRT_GLOBAL_DISPLACEMENT_Z

mavueRobot.Visible = True
mavueRobot.Redraw (True)

robapp.Project.ViewMngr.Refresh

' making screen capture
Dim ScPar As RobotViewScreenCaptureParams
Set ScPar = robapp.CmpntFactory.Create(I_CT_VIEW_SCREEN_CAPTURE_PARAMS)

ScPar.Name = "My screen capture"
ScPar.UpdateType = I_SCUT_UPDATED_UPON_PRINTING
mavueRobot.MakeScreenCapture ScPar

 

robapp.Project.PrintEngine.SaveReportToOrganizer


End Sub

to create png screen capture with highest reolution

ScPar.UpdateType = I_SCUT_CURRENT_VIEW
ScPar.Resolution = I_VSCR_4096

then you have to export printout to word or save as rtf
or copy directly screen shot to clipboard

ScPar.UpdateType = I_SCUT_COPY_TO_CLIPBOARD
ScPar.Resolution = I_VSCR_4096

then paste clipboard contents in Word

Dim ScPar As RobotViewScreenCaptureParams
Set ScPar = robapp.CmpntFactory.Create(I_CT_VIEW_SCREEN_CAPTURE_PARAMS)

ScPar.Name = "My screen capture"
ScPar.UpdateType = I_SCUT_CURRENT_VIEW
ScPar.Resolution = I_VSCR_4096
mavueRobot.MakeScreenCapture ScPar


robapp.Project.PrintEngine.AddScToReport "My screen capture"

robapp.Project.PrintEngine.SaveReportToOrganizer

' saving printout \ report to file

robapp.Project.PrintEngine.SaveReportToFile "c:\Autodesk\output\rr.rtf", I_OFF_RTF_JPEG

'or directly opening printout in Word

robapp.Project.PrintEngine.ExternalPreviewReport EPF_MS_OFFICE

[Stephane.kapetanovic]

next msg

Try this - change zoomfactor:

 

 

 

Set RobApp = New RobotApplication

 


Dim viewRobot As IRobotView3

Set viewRobot = RobApp.Project.ViewMngr.GetView(1)

 viewRobot.Redraw (True)

viewRobot.Projection = I_VP_XY

viewRobot.ParamsFeMap.CurrentResult = I_VFMRT_DETAILED_MOMENT_XY


RobApp.Project.ViewMngr.Refresh

 

Dim l As Double, t As Double, b As Double, r As Double
l = 0
t = 0
b = 0
r = 0

viewRobot.GetZoom l, t, r, b

Dim CenterX As Double
Dim CenterY As Double
Dim VX As Double
Dim VY As Double

CenterX = (l + r) / 2
CenterY = (t + b) / 2

 

Dim zoomfacfor As Double
zoomfactor = 2
VX = Abs(l - CenterX) / zoomfactor
VY = Abs(t - CenterY) / zoomfactor

viewRobot.SetZoom CenterX + VX, CenterY + VY, CenterX - VX, CenterY - VY


RobApp.Project.ViewMngr.Refresh

viewRobot.SetZoom CenterX + VX, CenterY + VY, CenterX - VX, CenterY - VY
viewRobot.Redraw(True) ' <- I have not used this command, take a look in my code or use   ...Redraw(0)
RobApp.Project.ViewMngr.Refresh

Ruler :

mavueRobot.ParamsDisplay.Set I_VDA_OTHER_RULER, True
robapp.Project.ViewMngr.Refresh

Object Inspector - not possible to open \ close it by API

mavueRobot.ParamsDisplay.Set I_VDA_ADVANCED_OFFSETS, False      'afficher exentrements
mavueRobot.ParamsDisplay.Set I_VDA_SECTIONS_SHAPE, False        'afficher croquis barres
mavueRobot.ParamsDisplay.Set I_VDA_SECTIONS_SYMBOLS, True       'afficher symboles barres
mavueRobot.ParamsDisplay.Set I_VDA_FE_PANEL_THICKNESSES, False  'afficher epaisseur panneaux
mavueRobot.ParamsDisplay.Set I_VDA_SECTIONS_COLORS, False       'afficher profilés en couleur
mavueRobot.ParamsDisplay.Set I_VDA_FE_FE_INTERIOR, False        'interieur element finis
mavueRobot.ParamsDisplay.Set I_VDA_FE_CLADDING_INTERIOR, False  'interieur bardages
mavueRobot.ParamsDisplay.Set I_VDA_FE_PANEL_INTERIOR, False     'interieur panneaux
mavueRobot.ParamsDisplay.Set I_VDA_FE_FINITE_ELEMENTS, False    'afficher elements finis
mavueRobot.ParamsDisplay.Set I_VDA_LOADS_VALUES, True               'valeurs charges
mavueRobot.ParamsDisplay.Set I_VDA_LOADS_SYMBOLS_UNIFORM_SIZE, True '
mavueRobot.ParamsDisplay.Set 68, True                               'symbole charges ponctuelles
mavueRobot.ParamsDisplay.Set 69, True                               'symbole charges lineaires
mavueRobot.ParamsDisplay.Set 70, True                               'symbole charges surfaciques

For i = 1 To 3

mavueRobot.Selection.Get(I_OT_CASE).FromText (i) ' selecting case

mavueRobot.Redraw (0)
robapp.Project.ViewMngr.Refresh

ecran_capture = "charges" & i

Call screen_capture

Next i

[Stephane.kapetanovic]

next msg

Sub cree_vues_resultats()

Dim mavueRobot As IRobotView3 ' this is important to set IRobotView3 if you want to make screen capture of this view

Set mavueRobot = robapp.Project.ViewMngr.GetView(1) ' it seems CreateView makes this strange affect, use GetView instead

mavueRobot.ParamsDisplay.Set I_VDA_OTHER_RULER, True


mavueRobot.Visible = True
mavueRobot.Redraw (True)
robapp.Project.ViewMngr.Refresh

' displaying map

mavueRobot.ParamsFeMap.WithDescription = True
mavueRobot.ParamsDisplay.Set I_VDA_SECTIONS_SYMBOLS, False

mavueRobot.ParamsFeMap.CurrentResult = I_VBMRT_NTM_MY

For i = 1 To 26
mavueRobot.Selection.Get(I_OT_CASE).FromText (i) ' selecting case for results display
ecran_capture = "moments My - Cas " & i
mavueRobot.Redraw (0)
robapp.Project.ViewMngr.Refresh

Call screen_capture
Next i

End Sub

Public robapp As RobotApplication

Private Sub CommandButton1_Click()

Set robapp = New RobotApplication
Dim viewRobot As IRobotView3 ' this is important to set IRobotView3 if you want to make screen capture of this view

Set viewRobot = robapp.Project.ViewMngr.GetView(1)
viewRobot.Projection = I_VP_3DXYZ
viewRobot.Redraw (True)
robapp.Project.ViewMngr.Refresh

Call screen_capture
End Sub


Sub screen_capture()

Dim viewRobot As IRobotView3
Set viewRobot = robapp.Project.ViewMngr.GetView(1)
Dim ScPar As RobotViewScreenCaptureParams
Set ScPar = robapp.CmpntFactory.Create(I_CT_VIEW_SCREEN_CAPTURE_PARAMS)

ScPar.Name = "capture"
ScPar.UpdateType = I_SCUT_CURRENT_VIEW
ScPar.Resolution = I_VSCR_4096
viewRobot.MakeScreenCapture ScPar
robapp.Project.PrintEngine.AddScToReport "capture"

End Sub

Sub screen_capture()

Dim mavueRobot As IRobotView3
Set mavueRobot = robapp.Project.ViewMngr.GetView(1)
Dim ScPar As RobotViewScreenCaptureParams
Set ScPar = robapp.CmpntFactory.Create(I_CT_VIEW_SCREEN_CAPTURE_PARAMS)

ScPar.Name = "capture"
ScPar.UpdateType = I_SCUT_COPY_TO_CLIPBOARD
mavueRobot.MakeScreenCapture ScPar
robapp.Project.PrintEngine.AddScToReport "capture"

End Sub

Dim SimpleCaseSel As RobotSelection
Dim ManualCombSel As RobotSelection

Set SimpleCaseSel = RobApp.Project.Structure.Selections.CreatePredefined(I_PS_CASE_SIMPLE_CASES)
Set ManualCombSel = RobApp.Project.Structure.Selections.CreatePredefined(I_PS_CASE_COMBINATIONS)

mavueRobot.Selection.Get(I_OT_CASE).FromText (SimpleCaseSel.ToText) ' all simple case for results display

'or

mavueRobot.Selection.Get(I_OT_CASE).FromText (ManualCombSel.ToText) ' all manual combinations for results display

Dim Rtable As RobotTable
Dim ScPar As RobotTableScreenCaptureParams
Set ScPar = robapp.CmpntFactory.Create(I_CT_TABLE_SCREEN_CAPTURE_PARAMS)

ScPar.Name = "Rtable"

Set Rtable = robapp.Project.ViewMngr.CreateTable(I_TT_BARS, I_TDT_BAR)
'  Rtable.AddColumn 1  -  modify tables if you want by adding or removing columns
Rtable.MakeScreenCapture ScPar

Sub robot_donnees()

' ouverture de robot, la session s'appellera robapp
Set Robapp = New RobotApplication

' ce sera une structure de type panneaux
Robapp.Project.New (I_PT_SHELL)
    


Robapp.Project.Open "c:\RG\Fichier structure.rtd"


Robapp.Project.CalcEngine.Calculate ' calculate model


Dim mavueRobot As IRobotView3 ' this is important to set IRobotView3 if you want to make screen capture of this view
Set mavueRobot = Robapp.Project.ViewMngr.GetView(1)


'Vue mise a jour
mavueRobot.Projection = I_VP_3DXYZ
mavueRobot.Redraw (True)
mavueRobot.ParamsDisplay.SymbolSize = 2 'marche uniquement avec ROBOT 2012
Robapp.Project.ViewMngr.Refresh

Robapp.Project.SaveToFormat I_PSF_RTD, "c:\RG\Fichier structure_1.rtd"

MsgBox "QUITTER APPLICATION ROBOT"

Robapp.Quit I_QO_DISCARD_CHANGES  ' Quitter sans sauvegarde


End Sub

[Stephane.kapetanovic]

next msg

Dim v As RobotView
Set v = RobApp.Project.ViewMngr.GetView(1)
v.SetVisibilityStatus I_VVST_ENVELOPES, I_VVSV_ENVELOPES_MAX

'for bottom envelope
'v.SetVisibilityStatus I_VVST_ENVELOPES, I_VVSV_ENVELOPES_MIN

v.Redraw 1

Dim v As RobotView
Set v = RobApp.Project.ViewMngr.GetView(1)

Dim l As Double, t As Double, b As Double, r As Double
l = 0
t = 0
b = 0
r = 0

v.GetZoom l, t, r, b

v.SetVisibilityStatus I_VVST_ENVELOPES, I_VVSV_ENVELOPES_MAX

'for bottom envelope
'v.SetVisibilityStatus I_VVST_ENVELOPES, I_VVSV_ENVELOPES_MIN

v.Redraw 1

v.SetZoom l, t, r, b

RobApp.Project.ViewMngr.Refresh

Dim v As RobotView
Set v = RobApp.Project.ViewMngr.GetView(1)

v.SetVisibilityStatus I_VVST_ENVELOPES, I_VVSV_ENVELOPES_MAX

'for bottom envelope
'v.SetVisibilityStatus I_VVST_ENVELOPES, I_VVSV_ENVELOPES_MIN

RobApp.Project.ViewMngr.Refresh

  Dim RSel As RobotSelection
    Set RSel = RobApp.Project.Structure.Selections.CreateFull(I_OT_PANEL)
    Dim PanelCol As RobotObjObjectCollection
    Set PanelCol = RobApp.Project.Structure.Objects.GetMany(RSel)
    
    Dim X As RobotGeoPoint3D, Y As RobotGeoPoint3D, Z As RobotGeoPoint3D
    Dim Obj As RobotObjObject
    
    Set X = RobApp.CmpntFactory.Create(I_CT_GEO_POINT_3D)
    Set Y = RobApp.CmpntFactory.Create(I_CT_GEO_POINT_3D)
    Set Z = RobApp.CmpntFactory.Create(I_CT_GEO_POINT_3D)
        
    For ii = 1 To PanelCol.Count
        
        Set Obj = PanelCol.Get(ii)
        Obj.Main.Attribs.GetLCS X, Y, Z
        
        Cells(12 + ii, 3) = Obj.Number
        Cells(12 + ii, 4) = "LCS X=" + Str(X.X) + ";" + Str(X.Y) + ";" + Str(X.Z)
        Cells(12 + ii, 5) = "LCS Y=" + Str(Y.X) + ";" + Str(Y.Y) + ";" + Str(Y.Z)
        Cells(12 + ii, 6) = "LCS Z=" + Str(Z.X) + ";" + Str(Z.Y) + ";" + Str(Z.Z)
        
    Next ii

    Dim X As Double, Y As Double, Z As Double
    Obj.Main.Attribs.GetDirX X, Y, Z

Sub screen_capture()

Dim viewRobot As IRobotView3
Set viewRobot = robapp.Project.ViewMngr.GetView(1)
Dim ScPar As RobotViewScreenCaptureParams
Set ScPar = robapp.CmpntFactory.Create(I_CT_VIEW_SCREEN_CAPTURE_PARAMS)

ScPar.Name = "capture"
ScPar.UpdateType = I_SCUT_CURRENT_VIEW
ScPar.Resolution = I_VSCR_4096
viewRobot.MakeScreenCapture ScPar
robapp.Project.PrintEngine.AddScToReport "capture"

End Sub

fichier_sortie = "d:\prb\outjpg.rtf"
RobApp.Project.PrintEngine.SaveReportToFile fichier_sortie, I_OFF_RTF_JPEG
fichier_sortie = "d:\prb\out.rtf"
RobApp.Project.PrintEngine.SaveReportToFile fichier_sortie, I_OFF_RTF

Dim ScPar As RobotViewScreenCaptureParams
Set ScPar = robapp.CmpntFactory.Create(I_CT_VIEW_SCREEN_CAPTURE_PARAMS)

ScPar.Name = "capture"
ScPar.UpdateType = I_SCUT_CURRENT_VIEW
ScPar.Resolution = I_VSCR_4096
ScPar.UpdateType = I_SCUT_COPY_TO_CLIPBOARD

view.MakeScreenCapture ScPar

Sub Copy_RobotCapture_To_WordDocument()
  ' Word
  Dim wordApp As Word.Application
  Dim wdDoc As Word.Document
  Dim paragraph As Word.paragraph

  Set wordApp = CreateObject("Word.Application")
  Set wdDoc = wordApp.Documents.Add
  
  ' Autodesk Robot Structural Analysis
  Dim RobApp As IRobotApplication
  Dim ViewMngr As IRobotViewMngr
  Dim ExportView As RobotView
  Dim ScPar As RobotViewScreenCaptureParams

  Set RobApp = New RobotApplication
  If RobApp.Visible = False Then
    Set RobApp = Nothing: Exit Sub
  End If
  
  Set ViewMngr = RobApp.Project.ViewMngr
  For i = 1 To ViewMngr.ViewCount
    If ViewMngr.GetView(i).Window.IsActive <> 0 Then
      ActiveViewNumber = i: Exit For
    End If
  Next i
  Set ExportView = ViewMngr.GetView(ActiveViewNumber)
  ' -------------
  ' Do something
  ' -------------
  Set ScPar = RobApp.CmpntFactory.Create(I_CT_VIEW_SCREEN_CAPTURE_PARAMS)
  ScPar.UpdateType = I_SCUT_COPY_TO_CLIPBOARD
  ScPar.Resolution = I_VSCR_2048
  ExportView.MakeScreenCapture ScPar
  
  Set paragraph = wdDoc.Content.Paragraphs.Add
  paragraph.Range.Text = " "
  paragraph.Range.Paste
  paragraph.Range.InsertParagraphAfter
    
  wordApp.Visible = True
  Set wdDoc = Nothing: Set wordApp = Nothing
  Set RobApp = Nothing
End Sub