Error with excel object




Could someon help me solve this issue


The idea of the code is to split a set of elements into smaller groups and find the mass and CG of each group and write it in a excel document.

Sub Main
  Dim App As femap.model
  Set App = feFemap()
  Dim wbkReport As Excel.Workbook
  Dim wksReport As Excel.Worksheet

  Set wbkReport = appExcel.Workbooks.add
  Set wksReport = wbkReport.Worksheets(1)
  Dim feSort As femap.SortSet
  Set feSort = App.feSort

  Dim feCSys As femap.CSys
  Set feCSys = App.feCSys

  Dim vBase As Variant
  Dim xyPoint(2) As Double
  Dim vDir As Variant
  Dim vRef As Variant
  Dim dLength As Double

  Dim elSet As femap.Set
  Set elSet = App.feSet
  Dim elSet1 As femap.DrawErase
  Set elSet1 = App.feDrawErase
  Dim elSet2 As femap.Set
  Set elSet2 = App.feSet

  Dim elCG As Variant
  Dim elCG_Trans As Variant

  Dim feElem As femap.Elem
  Set feElem = App.feElem
  Dim tx As Double
  Dim ty As Double
  Dim tz As Double
  Dim xPt(2) As Double

  Dim rc As Integer
  Dim gr As femap.Group
  Set gr = App.feGroup
  While gr.Next
   rc = gr.Delete(gr.ID)  
  App.feAppMessage(FCM_NORMAL, "All Groups deleted" )

  If App.feVectorPick( "Choose Vector Direction", True, dLength, vBase, vDir ) = FE_OK Then
   'Display dialog box to allow user to pic or enter vector,(dlgTitle, unitVector, vec Length, vecBase,vecDir)'
   If App.feVectorPerpendicular( vDir, vRef ) = FE_OK Then
    'Computes a arbitrary vector perpendicular to specified vector,(vecIn,vecOut)'
    xPt(0) = vBase(0) + vDir(0)
    xPt(1) = vBase(1) + vDir(1)
    xPt(2) = vBase(2) + vDir(2)
    xyPoint(0) = vBase(0) + vRef(0)
    xyPoint(1) = vBase(1) + vRef(1)
    xyPoint(2) = vBase(2) + vRef(2)
    feCSys.type = FCS_RECTANGULAR
    If feCSys.XYPoints( vBase, xPt, xyPoint ) = FE_OK Then
     'updates the origin and rotations of a coordinate system based on three locations that you specify, (origin,xaxis,xyplane)'
     If elSet.Select( FT_ELEM, True, "Pick Elements to Process" ) = FE_OK Then
      'Display a selection dialog box to allow a user to choose entities of a specific type and create a selection set,(entityTYpE;clear;title)'
      If feCSys.Put( feCSys.NextEmptyID ) = FE_OK Then
       'Stores data from current data object,(entID)'
       'Finds the ID of the next nonexisting entity with a higher ID'
       While feElem.NextInSet( elSet.ID ) = FE_OK
        'Retrives the next available entity with a larger ID that is referenced in the set'
        If feElem.GetCentroid( elCG ) = FE_OK Then
         'returns the centroid of an element(cgXYZ)'
         If App.feCoordTransform( 0, elCG, feCSys.ID, elCG_Trans ) = FE_OK Then
          'Transforms coordinate from one system to another(fromCSYS (ID of the coordinate system),fromXYZ(coordinate to transform),toCSYS(Id of the coordinat esystem to transform to),xyz(transformed coodinate))'
          feSort.AddReal( feElem.ID, elCG_Trans(0), 0.0, 0.0 )
          'Adds an ID and associated real properties into a sort object'
         End If
        End If
      End If
     End If
    End If
   End If
  End If

  Dim elemID As Long
  Dim xLow As Double
  Dim xHigh As Double
  Dim nos As Long
  Dim Striplen As Long
  Dim i As Long
  Dim pos0 As Long
  Dim pos1 As Long
  Dim n As Long
  Dim g As Group
  Set g = App.feGroup
  Dim elSet3 As femap.Set
  Set elSet3 = App.feSet
  Dim elSet4 As femap.Set
  Set elSet4 = App.feSet
  Dim elSet5 As femap.Set
  Set elSet5 = App.feSet
  If feSort.Count > 0 Then
   App.feAppMessage( FCM_NORMAL, "Processed " + Str$(feSort.Count) + " Elements" )
   feSort.Sort( True )
   'Sorts the IDs in the object based in values associated with each ID, if true, sorted based on dRealX values, if false, sort based on nIntX values'

   elemID = feSort.First
   elSet.Add( elemID )
   feSort.GetReal( elemID, tx, ty, tz )
   xLow = tx
   'App.feAppMessage( FCM_NORMAL, "Low X Elem " + Str$(elemID) + " value " + Str$(xLow ) )
   elemID = feSort.Last
   elSet.Add( elemID )
   feSort.GetReal( elemID, tx, ty, tz )
   xHigh = tx
   'App.feAppMessage( FCM_NORMAL, "High X Elem " + Str$(elemID) + " value " + Str$(xHigh ) )

   dLength = xHigh - xLow
   App.feAppMessage( FCM_NORMAL, "Distance = " + Str$(dLength ) )
   elSet.Show( FT_ELEM )

   App.feGetInt("Enter the number of strips ", 0, n, nos)
   Striplen =dLength/nos
   App.feAppMessage( FCM_NORMAL, "Strip Length = " + Str$(Striplen) )
  End If 
  For i=1 To nos
   App.feAppMessage( FCM_NORMAL, "pos0: " + Str$(pos0) + " pos1: " + Str$(pos1))
   Dim vbXYZ(2) As Boolean
   Dim vnMode(2) As Long
   Dim vdMin(2) As Double
   Dim vdMax(2) As Double
   vbXYZ(0)=True : vbXYZ(1)=False  :vbXYZ(2)=False
   vnMode(0)=3 : vnMode(1)=3 : vnMode(2)=3
   vdMin(0)=pos0 : vdMin(1)=0 : vdMin(2)=0
   vdMax(0)=pos1 : vdMax(1)=0 : vdMax(2)=0
   rc = elSet2.Clear
   rc = elSet2.AddCoordinate(FT_ELEM,feCSys.ID,vbXYZ,vnMode,vdMin,vdMax)
   App.feAppMessage( FCM_NORMAL, "Number of Elements in elSet2 = " + Str$(elSet2.Count) )
   gID = g.NextEmptyID
   Set g = App.feGroup
   g.title = "Temp"+Str$(i)
   g.SetAdd2( FGR_ELEM, elSet2.ID)
   'adds All entities In a Set To a Group, based On the specified Group data Type(GroupDataType,SetID)'
   g.Put( gID )
  Next i
  For i=1 To nos
   rc = elset3.AddGroup( FT_ELEM, i )
   rc = elset4.AddGroup( FT_ELEM, i+1 )
   rc = elset3.RemoveSet(elset4.ID)
    gID = g.NextEmptyID
    Set g = App.feGroup
    g.title = "Strip"+Str$(i)
    g.SetAdd2( FGR_ELEM, elSet3.ID)
    'adds All entities In a Set To a Group, based On the specified Group data Type(GroupDataType,SetID)'
    g.Put( gID )
  Next i
   Dim cs As Variant
   Dim length As Double
   Dim area As Double
   Dim volume As Double
   Dim structMass As Double
   Dim nonstructMass As Double
   Dim totalMass As Double
   Dim structCG As Variant
   Dim nonstructCG As Variant
   Dim totalCG As Variant
   Dim Inertia As Variant
   Dim inertiaCG As Variant
   cs = Array(0, 0, 0)
   Worksheets(1):cells(1,1).Value = "Name"
   Worksheets(1):cells(1,2).Value = "Structural Mass"
   Worksheets(1):cells(1,3).Value = "Non-structural Mass"
   Worksheets(1):cells(1,4).Value = "Total Mass"
   Worksheets(1):cells(1,5).Value = "Total CG"
   Worksheets(1):cells(1,6).Value = "Inertia"
  For i=1 To nos
   rc = elset5.AddGroup( FT_ELEM, i+nos )
   rc = App.feMeasureMeshMassProp(elset5.ID, 0, True, False, length, area, volume, structMass, nonstructMass, totalMass, structCG, nonstructCG, totalCG, Inertia, inertiaCG)
   Worksheets(1):cells(i+1,1).Value = "Strip" + Str$(i)
   Worksheets(1):cells(i+1,2).Value = structMass
   Worksheets(1):cells(i+1,3).Value = nonstructMass
   Worksheets(1):cells(i+1,4).Value = totalMass
   Worksheets(1):cells(i+1,5).Value = totalCG
   Worksheets(1):cells(i+1,6).Value = Inertia
  Next i

  appExcel.visible = True

End Sub


Re: Error with excel object

Gears Phenom Gears Phenom
Gears Phenom

Hello John,


you should add Excel as Reference (right click and using command References... in API Pane), and make same modification in your code:


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

  Dim appExcel As Excel.Application
  Dim wbkReport As Excel.Workbook
  Dim wksReport As Excel.Worksheet

  Set appExcel =  New Excel.Application
  Set wbkReport = appExcel.Workbooks.Add
  Set wksReport = wbkReport.Worksheets(1)


  appExcel.Visible = True

End Sub


Best regards


Peter Kaderasz

Re: Error with excel object


Thank you very much!