Sub Main()
Dim App As femap.model
Set App = feFemap()
'==================================================
' USER INPUT
'==================================================
Dim ConstraintSetID As Long
ConstraintSetID = 4
Dim OutputSetID As Long
OutputSetID = 221
'==================================================
' RESULTS OBJECT
'==================================================
Dim RBO As femap.Results
Set RBO = App.feResults
Dim ndSet As femap.Set
Set ndSet = App.feSet
'==================================================
' CONSTRAINT OBJECTS
'==================================================
Dim feBCSet As femap.BCSet
Set feBCSet = App.feBCSet
Dim feBCGeom As femap.BCGeom
Set feBCGeom = App.feBCGeom
Dim feBCNode As femap.BCNode
Set feBCNode = App.feBCNode
Dim p As femap.Point
Set p = App.fePoint
Dim s As femap.Surface
Set s = App.feSurface
Dim c As femap.Curve
Set c = App.feCurve
'==================================================
' FORCE VECTOR IDs
'==================================================
Dim fxVecID As Long
Dim fyVecID As Long
Dim fzVecID As Long
fxVecID = 52
fyVecID = 53
fzVecID = 54
'==================================================
' NODE ARRAYS
'==================================================
Dim txNodes() As Long
Dim tyNodes() As Long
Dim tzNodes() As Long
Dim txCount As Long
Dim tyCount As Long
Dim tzCount As Long
txCount = 0
tyCount = 0
tzCount = 0
ReDim txNodes(0)
ReDim tyNodes(0)
ReDim tzNodes(0)
Dim Nodes As Variant
Dim numNodes As Long
Dim i As Long
Dim rc As Long
'==================================================
' GET CONSTRAINT SET
'==================================================
If feBCSet.Get(ConstraintSetID) <> FE_OK Then
App.feAppMessage FCM_ERROR, "Constraint Set not found!"
Exit Sub
End If
feBCSet.Active = ConstraintSetID
'==================================================
' GEOMETRY CONSTRAINTS
'==================================================
feBCGeom.Reset
While feBCGeom.Next
' POINT
If feBCGeom.geomTYPE = 3 Then
rc = p.Get(feBCGeom.geomID)
If rc = FE_OK Then
rc = p.Nodes(numNodes, Nodes)
If rc = FE_OK Then
For i = 0 To numNodes - 1
If feBCGeom.dof(0) Then
txNodes(txCount) = Nodes(i)
txCount = txCount + 1
ReDim Preserve txNodes(txCount)
End If
If feBCGeom.dof(1) Then
tyNodes(tyCount) = Nodes(i)
tyCount = tyCount + 1
ReDim Preserve tyNodes(tyCount)
End If
If feBCGeom.dof(2) Then
tzNodes(tzCount) = Nodes(i)
tzCount = tzCount + 1
ReDim Preserve tzNodes(tzCount)
End If
Next i
End If
End If
End If
' CURVE
If feBCGeom.geomTYPE = 4 Then
rc = c.Get(feBCGeom.geomID)
If rc = FE_OK Then
rc = c.Nodes(True, True, numNodes, Nodes)
If rc = FE_OK Then
For i = 0 To numNodes - 1
If feBCGeom.dof(0) Then
txNodes(txCount) = Nodes(i)
txCount = txCount + 1
ReDim Preserve txNodes(txCount)
End If
If feBCGeom.dof(1) Then
tyNodes(tyCount) = Nodes(i)
tyCount = tyCount + 1
ReDim Preserve tyNodes(tyCount)
End If
If feBCGeom.dof(2) Then
tzNodes(tzCount) = Nodes(i)
tzCount = tzCount + 1
ReDim Preserve tzNodes(tzCount)
End If
Next i
End If
End If
End If
' SURFACE
If feBCGeom.geomTYPE = 5 Then
rc = s.Get(feBCGeom.geomID)
If rc = FE_OK Then
rc = s.Nodes(True, True, numNodes, Nodes)
If rc = FE_OK Then
For i = 0 To numNodes - 1
If feBCGeom.dof(0) Then
txNodes(txCount) = Nodes(i)
txCount = txCount + 1
ReDim Preserve txNodes(txCount)
End If
If feBCGeom.dof(1) Then
tyNodes(tyCount) = Nodes(i)
tyCount = tyCount + 1
ReDim Preserve tyNodes(tyCount)
End If
If feBCGeom.dof(2) Then
tzNodes(tzCount) = Nodes(i)
tzCount = tzCount + 1
ReDim Preserve tzNodes(tzCount)
End If
Next i
End If
End If
End If
Wend
'==================================================
' NODAL CONSTRAINTS
'==================================================
feBCNode.Reset
While feBCNode.Next
If feBCNode.dof(0) Then
txNodes(txCount) = feBCNode.ID
txCount = txCount + 1
ReDim Preserve txNodes(txCount)
End If
If feBCNode.dof(1) Then
tyNodes(tyCount) = feBCNode.ID
tyCount = tyCount + 1
ReDim Preserve tyNodes(tyCount)
End If
If feBCNode.dof(2) Then
tzNodes(tzCount) = feBCNode.ID
tzCount = tzCount + 1
ReDim Preserve tzNodes(tzCount)
End If
Wend
'==================================================
' FORCE RESULTS
'==================================================
Dim totalTX As Double
Dim totalTY As Double
Dim totalTZ As Double
Dim vals As Variant
Dim ids As Variant
Dim idx As Variant
Dim nCol As Long
Dim colID As Long
totalTX = 0
totalTY = 0
totalTZ = 0
'==================================================
' TX NODES -> VECTOR 52
'==================================================
App.feAppMessage FCM_NORMAL, "===== TX NODES ====="
ndSet.Clear
For i = 0 To txCount - 1
App.feAppMessage FCM_NORMAL, Str(txNodes(i))
ndSet.Add txNodes(i)
Next i
RBO.Clear
RBO.AddColumnV2 OutputSetID, 52, False, nCol, idx
RBO.DataNeeded FT_NODE, ndSet.ID
RBO.Populate
RBO.SendToDataTable
If IsArray(idx) Then
colID = idx(0)
Else
colID = idx
End If
RBO.GetColumn colID, ids, vals
If IsArray(vals) Then
For i = 0 To UBound(vals)
totalTX = totalTX + vals(i)
Next i
Else
totalTX = vals
End If
If Abs(totalTX) < 0.000001 Then totalTX = 0
App.feAppMessage FCM_NORMAL, "Total FX = " & Format(totalTX, "0.###")
'==================================================
' TY NODES -> VECTOR 53
'==================================================
App.feAppMessage FCM_NORMAL, "===== TY NODES ====="
ndSet.Clear
For i = 0 To tyCount - 1
App.feAppMessage FCM_NORMAL, Str(tyNodes(i))
ndSet.Add tyNodes(i)
Next i
RBO.Clear
RBO.AddColumnV2 OutputSetID, 53, False, nCol, idx
RBO.DataNeeded FT_NODE, ndSet.ID
RBO.Populate
RBO.SendToDataTable
If IsArray(idx) Then
colID = idx(0)
Else
colID = idx
End If
RBO.GetColumn colID, ids, vals
If IsArray(vals) Then
For i = 0 To UBound(vals)
totalTY = totalTY + vals(i)
Next i
Else
totalTY = vals
End If
If Abs(totalTY) < 0.000001 Then totalTY = 0
App.feAppMessage FCM_NORMAL, "Total FY = " & Format(totalTY, "0.###")
'==================================================
' TZ NODES -> VECTOR 54
'==================================================
App.feAppMessage FCM_NORMAL, "===== TZ NODES ====="
ndSet.Clear
For i = 0 To tzCount - 1
App.feAppMessage FCM_NORMAL, Str(tzNodes(i))
ndSet.Add tzNodes(i)
Next i
RBO.Clear
RBO.AddColumnV2 OutputSetID, 54, False, nCol, idx
RBO.DataNeeded FT_NODE, ndSet.ID
RBO.Populate
RBO.SendToDataTable
If IsArray(idx) Then
colID = idx(0)
Else
colID = idx
End If
RBO.GetColumn colID, ids, vals
If IsArray(vals) Then
For i = 0 To UBound(vals)
totalTZ = totalTZ + vals(i)
Next i
Else
totalTZ = vals
End If
If Abs(totalTZ) < 0.000001 Then totalTZ = 0
App.feAppMessage FCM_NORMAL, "Total FZ = " & Format(totalTZ, "0.###")
End Sub
