Showing results for 
Search instead for 
Do you mean 
Reply
Solved! Go to solution

Text (labels) for Mass points

[ Edited ]

Since I haven't found how to show the applied mass for the Point Masses, I have created an API to create labels.

 

I have run into two problems:

 

1, when the mass point is defined on a node (and the node is attached to an RBE element) the NodeID=feELEM.Node(0) returns an Overflow error. 

 

2, for the mass points that are defined on normal nodes, the macro seems to run fine, but the text size is different (although in the Text object properties there is no ".size" attribute).

 

Anybody have any idea what could cause these issues?

 

Untitled 1.jpg

 

 

 

'This macro is created to label mass properties for point masses
'
'No Responsibility is Taken For Results Obtained From this API
'
'Written for FEMAP 11.2

' Rev. 0 , Date: 26-02-2017, Created by P. Barabas (barabas.pete [ at ] gmail.com)


Sub Main


	'Attach the active FEMAP model to the macro
	Dim App As femap.model
	Set App = GetObject(,"femap.model")

	'create an element set Object
	Dim Elem_set As Object
	Set Elem_set = App.feSet

	'create  element object
	Dim feElem As Object
	Set feElem = App.feElem

	'create  node object
	Dim feNode As Object
	Set feNode = App.feNode

	'create property object
	 Dim feProperty As Object
     Set feProperty = App.feProp

    Dim LabelText As Object
    Set LabelText = App.feText

	Dim nb_element As Long
	Dim PropID As Integer
	Dim NodeID As Integer
	Dim LabelID As Integer

	Dim ElemArray As Variant

	Dim Mx As Double
	Dim My As Double
	Dim Mz As Double

	Dim xyz(2) As Double

	
rc = App.feAppMessage(4, "**** API Mass property label ****") 	'Black bold
rc = App.feAppMessage(2, "**********************************")

'Label to navigate with GoTo
Select_element:

Elem_set.Select(FT_ELEM,True,"Select MASS elements to process")
'supress (remove) any plates selected accidentally
    Dim elt_plate As Object
    Set elt_plate = App.feSet
    elt_plate.AddRule(FET_L_PLATE,FGD_ELEM_BYTYPE)
    Elem_set.RemoveSet(elt_plate.ID)

 'supress (remove) any RIGIDS selected accidentally
    Dim elt_rigid As Object
    Set elt_rigid = App.feSet
    elt_rigid.AddRule(FET_L_RIGID,FGD_ELEM_BYTYPE)
    Elem_set.RemoveSet(elt_rigid.ID)

     'supress (remove) any SOLIDS selected accidentally
    Dim elt_solid As Object
    Set elt_solid = App.feSet
    elt_solid.AddRule(FET_L_SOLID,FGD_ELEM_BYTYPE)
    Elem_set.RemoveSet(elt_solid.ID)

If Elem_set.Count = 0 Then
	GoTo Select_element
	Else
		'do nothing
End If

nb_element=Elem_set.Count


	While Elem_set.Next

					feElem.ID = Elem_set.CurrentID

						'retrive property ID's for element

						rc = feElem.Get(ElemID)

						feProperty.Get (feElem.propID)

						PropID = feElem.propID


						rc = App.feAppMessage(2, "Property ID: " & PropID )

				'get the mass properties for the selected property ID

				Mx = feProperty.pval(7)
				My = feProperty.pval(11)
				Mz = feProperty.pval(12)

	rc = App.feAppMessage(2, "Mx: "& Mx & " My: "& My &" Mz: " & Mz )

		NodeID = feElem.Node(0)

		rc = feNode.Get(NodeID)

	  	xyz(0) = feNode.x
  		xyz(1) = feNode.y
   		xyz(2) = feNode.z

   		'rc = App.feAppMessage(2, "node ID " & NodeID & xyz(0) &"-"& xyz(1) &"-"&  xyz(2) )
   				rc = App.feAppMessage(2, "color " & feProperty.color )

   						LabelID = LabelText.NextEmptyID

						LabelText.ModelPosition = True
						LabelText.AllViews = True
						LabelText.DrawPointer = True
						LabelText.DrawBorder = True
						LabelText.color = feProperty.color
						LabelText.BackColor = 149
						LabelText.layer = ActiveLayer

						LabelText.TextPosition(0) = xyz(0)
						LabelText.TextPosition(1) =	xyz(1)
						LabelText.TextPosition(2) =	xyz(2)+2000

					 	LabelText.PointerPosition(0) = xyz(0)
						LabelText.PointerPosition(1) =	xyz(1)
						LabelText.PointerPosition(2) =	xyz(2)

						LabelText.FontNumber = LabelID




				'decide what to show on screen

				If Mx = My And My=Mz Then

							LabelText.text = "Mx=My=Mz= " & Mx

						rc = LabelText.Put(LabelID)

					Else

						LabelText.text = "Mx= " & Mx  & " My= " & My  & " Mz= " & Mz

						rc = LabelText.Put(LabelID)

				End If


	Wend




rc = App.feAppMessage(4, "****************************** Finished ***********************************")		'black bold

End Sub

 

 

2 REPLIES
Solution
Solution
Accepted by topic author PBarabas
‎02-27-2017 08:30 AM

Re: Text (labels) for Mass points

Hello,

2. the problem is this line: LabelText.FontNumber = LabelID

Font numbers in FEMAP include a notion of size

 

1. i don't replicate your problem...

 

Here's your code a little more condensed, to give you ideas on how you can reduce FEMAP APIs.

AP

 

 

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

    Dim Mx As Double, My As Double, Mz As Double

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

    Dim elSet As femap.Set, el As femap.Elem
    Set elSet = App.feSet
    Set el = App.feElem

    Dim pr As femap.Prop, n As femap.Node
    Set pr = App.feProp
    Set n = App.feNode

    Dim txt As femap.text
    Set txt = App.feText


    If elSet.Select(FT_ELEM,False,"Select MASS elements") = FE_CANCEL Then End

    'filter: keep only masses
    set1.AddRule(FET_L_MASS,FGD_ELEM_BYTYPE)
    elSet.RemoveNotCommon(set1.ID)
    If elSet.Count = 0 Then End

    With txt
        .ModelPosition = True : .AllViews = True : .DrawPointer = True
        .DrawBorder = True : .BackColor = 149 : .layer = 1
    End With

    While el.NextInSet(elSet.ID)
        pr.Get(el.propID)
        Mx = pr.pval(7) : My = pr.pval(11) : Mz = pr.pval(12)
        txt.color = pr.color

        n.Get(el.Node(0))
        For i = 0 To 2
            txt.TextPosition(i) = n.xyz(i)+IIf(i=2,2000,0)
            txt.PointerPosition(i) = n.xyz(i)
        Next

        If Mx = My And My = Mz Then
            txt.text = "Mx=My=Mz= " & Mx
        Else
            txt.text = "Mx= " & Mx  & " My= " & My  & " Mz= " & Mz
        End If
        txt.Put(txt.NextEmptyID)
    Wend

    App.feAppMessage(4, "****************************** Finished ***********************************")
End Sub

 

Re: Text (labels) for Mass points

Brilliant!

 

This is certainly more compact than my code.