Cancel
Showing results for 
Search instead for 
Did you mean: 

Api code for creating groups from color and to print to jpg.

Pioneer
Pioneer

Hi.

 

Is there a way to convert a recorded macro in femap to an API code ?? I have below an API code to run in femap to create groups from color, but my code seems to be off as I am not the familiar with programming. Any suggestions or changes to the code will help as well as an API code to save what is within the graphics window to a jpeg. Please help.

 

Sub Main
Dim App As femap.model
Set App = feFemap()

Dim color_ As femap.color
Set color_ = App.feColor

Dim group_ As femap.Group

Dim colorOnSurf_set As femap.Set
Set colorOnSurf_set = App.feSet

While color_.Next 'go through all colors
If (color_.ID <> 1) And (color_.ID <> 9999)
App.feAppMessage(FCM_NORMAL, "Working on color :" & Str(color_.ID) &"=>" & " " & color_.title )

colorOnSurf_set.Clear
colorOnSurf_set.AddEntitiesOnSurf( -color_.ID, FT_SURFACE) ' collect surfaces in the set


Set group_ = App.feGroup
group_.title = color_.title
group_.SetAdd(FT_SURFACE, colorOnSurf_set.ID) ' add surfaces from the set
group_.Put(group_.NextEmptyID)
End If
End While
Wend
End Sub

 
5 REPLIES

Re: Api code for creating groups from color and to print to jpg.

Phenom
Phenom

Hi,

This will do the trick.

As for saving a jpeg look at Help > API > 3.4.11.7 feFilePictureSave

AP

 

Sub Main
    Dim App As femap.model
    Set App = feFemap()

    Dim s As femap.Surface
    Set s = App.feSurface

    Dim colorSet1 As femap.Set, colorSet2 As femap.Set
    Set colorSet1 = App.feSet
    Set colorSet2 = App.feSet

    Dim sSet As femap.Set, gr As femap.Group
    Set sSet = App.feSet

    While s.Next
        If colorSet1.IsAdded(s.color) = FE_FAIL Then
            colorSet1.Add(s.color)
            colorSet2.Add(s.ID)
        End If
    Wend

    While colorSet2.Next
        sSet.Clear
        Set gr = App.feGroup

        sSet.AddRule(colorSet2.CurrentID,FGD_SURFACE_BYCOLOR)
        gr.SetAdd(FT_SURFACE,sSet.ID)

        s.Get(colorSet2.CurrentID)
        gr.title = "Color " & CStr(s.color)
        gr.Put(gr.NextEmptyID)
    Wend
End Sub

 

 

Re: Api code displaying text in graphics window and to print to jpg

Pioneer
Pioneer

Hi

 

Thanks a lot for the help astrium_tls it works perfectly. As for the feFilePictureSave below I have the code posted as I am failry new to API progrmming I am stumbling quite a bit. Any suggestions on making the save to a jpg code useable ?? I would really appreciate it. As well as I have posted a code for displaying the file name at the top of the graphics window and also struggling to get that to work.

 

Code for save file to jpg :

 

Sub main
Dim App As femap.model
Set App = feFemap()
Set f = App.feFilePictureSave

Dim sFileName As String
Dim fileFormat As Long
Dim feView As femap.View
Dim viewID As Long
Dim bsaveDesktop As Boolean

Set feView = App.feView
rc = App.feAppGetActiveView( viewID )
rc = feView.Get( viewID )
sFileName=App.ModelName
If sFileName="" Then
bsaveDesktop=False
Else
bsaveDesktop=True
index=InStrRev(sFileName,"\")
End If

If fileFormat = False Then
Select LCase (Right(fileFormat, Len(fileFormat_InstrRev(fileFormat, ".",1)))

Case 1 "Bitmap" : fileFormat = 1

Case 2 "Metafile" : fileFormat = 2

Case 3 "Placeable Metafile" : fileFormat = 3

Case 4 "Jpeg" : fileFormat = 4

Case 5 "Bitmap Series" : fileFormat = 5

Case Else : fileFormat = 0

End Select

If fileFormat = 0 Then
MsgBox "Sorry unkwown file format ."

End If

End If


End Sub

 

Code for display filename in graphics window :

 

Const wPC = 3 'width from left
Const hPC = 10 'height from top
Const vSpace = 4 'vertical spacing

Sub Main
Dim App As femap.model
Set App = feFemap()
Dim feView As femap.View
Dim viewID As Long
Dim txt As femap.text
Dim sFileName As String

Set feView = App.feView
rc = App.feAppGetActiveView( viewID )
rc = feView.Get( viewID )
sFileName=App.ModelName

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

.DrawBorder = False :.color = v.color(FVI_VIEW_LEGEND)
.text = "sFileName:"
.TextPosition (0) = wPC + 3 :.TextPosition (1) = hPC
.Put (txtID)

End With

 


End Sub

 

Re: Api code displaying text in graphics window and to print to jpg

Legend
Legend

Hello,

 

Very simple routine to save screenshot to specified file. 

FPRG_WINDOW - use only area where model is located.

D:\screenshot.jpg - file name to use

Sub Main
    Dim App As femap.model
    Set App = feFemap()

    App.feFilePictureSave2(False, FPRG_WINDOW , FPM_JPEG, "D:\screenshot")
End Sub

To make screenshot quickly the above tool should be able to generate automatically file name and put screen in project folder. (BAS file is attached)

SaveToJpeg.png

The above tool get folder of current model. If model is not saved - disk D:\ is used as path for screenshot. 

It creates screenshots with names "screenshot", "screenshot (1)" , etc. 

It checks if filename is used it increase number while find available name.

 

Yarko

 

Re: Api code displaying text in graphics window and to print to jpg

Phenom
Phenom

Hi,

For the 2nd one:

AP

 

Const wPC = 3 'width from left
Const hPC = 10 'height from top
Const vSpace = 4 'vertical spacing

Sub Main
    Dim App As femap.model
    Set App = feFemap()

    Dim s As String, l1 As Long

    Dim txt As femap.text, v As femap.View
    Set txt = App.feText
    Set v = App.feView

    App.feAppGetActiveView(l1)
    v.Get(l1)

    If App.ModelName <> "" Then s = App.ModelName Else s = "NA"

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

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

 

Re: Api code displaying text in graphics window and to print to jpg

Pioneer
Pioneer

Hi.

 

Thanks a lot for your help Yarko and AP.

Both APIs seem to run perfectly. Really aprreciate the help Smiley Happy