Cancel
Showing results for 
Search instead for 
Did you mean: 

Re: Calling shortcut keys in api

Pioneer
Pioneer

@yarko

 

Ok. Thanks. I just have one more question if you can help me with. After the jpeg has been saved how can I get it to display the path file of the jpeg on the graphics window ? Below is a code I have tried but instead of displaying the path of the jpeg it displays NA.

 

Dim modelPath As String
modelPath=App.ModelName
Dim directory As String
directory = Left(modelPath, InStrRev(modelPath, "\"))
Dim Height As Double
Dim Width As Double

Width = 37.2
Height = 46

App.feWindowSetRect(0, 0, 0, 37.2, 46)

'if model is not saved and not possible to get folder, use directory D
If (directory = "") Then directory = "D:\"

Dim screenShotPath As String
screenShotPath = directory & "s"

'find if screenshot (i) name is used and increase i to find not used name
Dim i As Integer
While (Dir(screenShotPath & ".jpg") <> "")
    i=i+1
    screenShotPath = directory & "s" & "(" & i &")"
Wend

App.feFilePictureSave2(True, FPRG_WINDOW , FPM_JPEG, screenShotPath)

If (Dir(screenShotPath & ".jpg")<>"") Then s = (Dir(screenShotPath & ".jpg")<>"") Else s = "NA"
With txt
    .ModelPosition = False :.AllViews = True
    .FontNumber = feView.Label(FVI_LABEL)

    .DrawBorder = False :.color = feView.color(FCL_BLACK)
    .text =" " & s
    .TextPosition (0) = wCP + 3 :.TextPosition (1) = hCP
    .Put(.NextEmptyID)
    End With
    App.feViewRegenerate(0)



End Sub

Re: Calling shortcut keys in api

Legend
Legend

Dear RedP,

 

 

I've run your macro and noticed one thing. In function to save picture first parameter is set to true - means that user define path to store file.  


App.feFilePictureSave2(True, FPRG_WINDOW , FPM_JPEG, screenShotPath)

feFilePictureSave2 function does not return path selected by user, it display it in message box.

message.png

Since user define path using dialog the screenShotPath is not used to save picture. That is why you get N/A for text.

 

message2.png

 

As you can see from above screen the path is where my model is located.

 

I have two suggestion how you can solve this:

1) use App.feFilePictureSave2(False, FPRG_WINDOW, FPM_JPEG, screenShotPath) but picture will be saved in folder with model and not by user defined path.

2) Find method in vb6 that allows to define path and later call feFilePictureSave2(false, ...) and selected path.

 

Yarko

 

Re: Calling shortcut keys in api

Pioneer
Pioneer

@yarko

 

Thanks a lot. Really appreciate the help. Smiley Happy

Re: Calling shortcut keys in api

Pioneer
Pioneer

@yarko

 

When I used

 

App.feFilePictureSave2(False, FPRG_WINDOW, FPM_JPEG, screenShotPath)

 

Instead of displaying the path on the screen it displays True. :/

Re: Calling shortcut keys in api

Legend
Legend

Dear RedP,

 

 

Can you post full macro and after lunch I will take a look.

 

Yarko

Re: Calling shortcut keys in api

Pioneer
Pioneer

@yarko

Below is the complete macro :

 

The HTML Clipboard

Const wPC = -9.5 'width from left
Const hPC = 7'height from top
Const vSpace = 4 'vertical spacing
Const wCp = 10
Const hCP = 12
Dim App As femap.model
Dim feView As Object
Dim savedView As Object
Dim savedViewTitle As String
Dim viewID As Long
Dim actViewID As Long

Sub LoadOView( act, save )
  rc = savedView.Put(act)
  rc = savedView.Visible(True)
  rc = App.feAppSetActiveView(act)
  rc = feView.Delete(save)
  rc = savedView.Regenerate()
End Sub

Sub Main
  Set App = feFemap()
  Set feView = App.feView()
  Set savedView = App.feView()
  Dim s As String
  Dim txt As femap.text
  Set txt = App.feText

  Set stdBackColor2 = 80
  Set stdBackColor = 0
  Set stdFGColor = 124
  Set prtBackColor = 124
  Set prtBackColor2 = 0
  Set prtFGColor = 0
  tempViewTitle="femapAPISavedPrintView"

  'Create view objects
  Dim num As Long
  Dim rc As Long
  Dim index As Long
  Dim e As Long

  'Get the Active View ID
  rc = App.feAppGetActiveView(viewID)

  If rc = FE_OK Then
    rc = feView.Get(viewID)
    If rc = FE_OK Then
      actViewID = viewID

'=============== revert view ==================
      'If the view color is already white, switch back to saved
      If feView.WindowBackColor = prtBackColor Then
        savedView.Reset()
        e = FE_OK
        Do While e <> FE_FAIL
          e = savedView.Next()
          If e <> FE_FAIL Then
            If(StrComp(savedView.title, tempViewTitle) = 0) Then
              savedView.title = feView.title
              savedViewID = savedView.ID
              LoadOView( actViewID, savedViewID)
              Exit All
            End If
          End If
        Loop
        ' if orig view not found switch back to femap standard
        '================= reset view =================
        feView.WindowBackColor2 =stdBackColor2
        feView.WindowBackColor = stdBackColor
        feView.WindowShadeBack = True
        feView.WindowShadeBackOpt = 0
        feView.color(FVI_LABEL) = stdFGColor
        feView.color(FVI_VIEW_LEGEND) = stdFGColor
        feView.color(FVI_POST_TITLES) = stdFGColor
        feView.ColorMode(FVI_CONTOUR_LEGEND) = 0
        feView.color(FVI_CONTOUR_LEGEND) = stdFGColor
        feView.color(FVI_SHRINK_ELEM) = stdElemColor
        feView.color(FVI_NODE) = stdFGColor
        feView.color(FVI_ELEMENT) = stdFGColor
        feView.Draw(FVI_ORIGIN) = 0
        rc = feView.Visible(True)
        rc = feView.Put(viewID)
        rc = feView.Regenerate()

'======== switch view to white bg And contrasting fg ========
      Else         '( white BG , black FG )
        Dim origTitle As String
        ' save orig view as temp view
        rc = savedView.Get(viewID)
        If (rc = FE_OK ) Then
          origTitle = savedView.title
          num = savedView.NextEmptyID()
          savedView.title = tempViewTitle
          savedView.Put(num)
        End If
        ' get original back into feview
        feView.Get(viewID)
        ' reset title to original
        feView.title = origTitle
        ' change colors
        feView.WindowBackColor2 = prtBackColor
        feView.WindowBackColor = prtBackColor
        feView.WindowShadeBack = False
        feView.ColorMode(FVI_LABEL) = 1
        feView.color(FVI_LABEL) =prtFGColor
        feView.color(FVI_VIEW_LEGEND) =prtFGColor
        feView.color(FVI_POST_TITLES) = prtFGColor
        'feView.ColorMode(FVI_NODE) = 1
        ' feView.color(FVI_NODE) = prtFGColor
        If( feView.Draw(FVI_FILL_ELEM) ) Then
          feView.ColorMode(FVI_FILLED_EDGES) = 3
          feView.color(FVI_FILLED_EDGES ) = prtFGColor
        Else
          feView.ColorMode(FVI_ELEMENT) = 1
          feView.color(FVI_ELEMENT) = prtFGColor
        End If
        feView.ColorMode(FVI_SHRINK_ELEM) = 1
        feView.color(FVI_SHRINK_ELEM) = prtFGColor
        feView.ColorMode (FVI_CONTOUR_LEGEND) = 1
        feView.color(FVI_CONTOUR_LEGEND) = prtFGColor
        feView.color(FVI_XY_AXES_STYLE) = 0
        feView.color(FVI_XY_TITLES) = prtFGColor
        feView.color(FVI_XY_XAXIS) = prtFGColor
        feView.color(FVI_XY_YAXIS) = prtFGColor
        feView.Draw(FVI_ORIGIN) = False
        feView.Draw(FVI_VIEW_AXES) = True

        rc = feView.Put(viewID)
        rc= feView.Visible(True)
        rc = feView.Regenerate()
      End If
    End If
  End If

 Dim FileName_withoutPath As String

If FileName_withoutPath <>"" Then s = FileName_withoutPath Else s = "NA"

    With txt
        .ModelPosition = False : .AllViews = True
        .FontNumber = feView.Label(FVI_LABEL)

        .DrawBorder = False : .color =feView.color(FCL_BLACK)
        .text = " " & s
        .TextPosition (0) = wPC + 3 :.TextPosition (1) = hPC
        .Put (.NextEmptyID)
    End With
    App.feViewRegenerate(0)


'get directory of femap model
Dim FileName As String
Dim modelPath As String
modelPath= FileName
Dim directory As String
directory = Left(modelPath, InStrRev(modelPath, "\"))
Dim Height As Double
Dim Width As Double

Width = 34.5
Height = 48.2

App.feWindowSetRect(0, 0, 0, 34.5, 48.2)

'if model is not saved and not possible to get folder, use directory D
If (directory = "") Then directory = "D:\"

Dim screenShotPath As String
screenShotPath = directory & "ScreenShot"

'find if screenshot (i) name is used and increase i to find not used name
Dim i As Integer
While (Dir(screenShotPath & ".jpg") <> "")
    i=i+1
    screenShotPath = directory & "ScreenShot" & "(" & i &")"
Wend

App.feFilePictureSave2(True, FPRG_WINDOW , FPM_JPEG, screenShotPath)

jpegPath = FileName_withPath
Dim myPath As String
myPath = Left(jpegPath, InStrRev(jpegPath, "\"))

 If myPath <>"" Then jpegPath = myPath Else jpegPath = "NA"
 With txt
    .ModelPosition = False :.AllViews = True
    .FontNumber = feView.Label(FVI_LABEL)

    .DrawBorder = False :.color = feView.color(FCL_BLACK)
    .text ="" & jpegPath
    .TextPosition (0) = wCp + 3 :.TextPosition (1) = hCP
    .Put(.NextEmptyID)
    End With
    App.feViewRegenerate(0)


End Sub

So in essence I want the API to first size the window to the respected window size the, switch the color background from the default to white, then it should display the model name without its path in the graphics window, then it should save the graphics window to a jpeg and then after the jpeg has been saved it should display the path of the jpeg including the jpeg file name on the graphics window. I have used theAPI from custom tools to switch the color background.

 

Really appreciate all the help.

Re: Calling shortcut keys in api

Legend
Legend

Dear RedP,

 

 

I've checked your macro. I've replaced some functions with simpler methods. For example it is possible to change view background by changing 2 properties.

Bas file is attached.

 

1) First we get what view is active then change 2 props: WindowShadeBack means no gradient, use one color.

2) I've made 2 small functions to get screenshot name and model name (in the end of the code). It makes main macro smaller and if you need model name for another macro it is easy to copy only that function.

3) I used for text fixed ID = 1001, because otherwise you have to control text, remove prev. (extra work).

4) Instead of Text object App.feTextPut is used. It does basically the same but in one line. 

 

screenshot_tool.png

 

Yarko

Re: Calling shortcut keys in api

Pioneer
Pioneer

@yarko

 

Thanks a lot. It works perfectly. I really appreciate all the help Smiley Happy