×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

FEMAP API - Extrude surface error

FEMAP API - Extrude surface error

FEMAP API - Extrude surface error

(OP)
Dear all,

I'm writing an Excel VBA comment, which should automatically build a plane with stiffened panels. In drawing the curves, I succeed, however when I try to extrude these curves I cannot get my code working. Can somebody check what I am doing wrong?

My excel file:

CODE -->

Dimensions (mm)	L	B
Web	366	12
Flange	16	125
		
Number of stiffeners	3	
Deck longitudinal spacing	800	
		
Panel width	2400	
Web frame spacing	4500 

My code:

CODE -->

Sub butBuilt_Click()
    
    Dim rc As Integer
    Dim ID As Integer
    Dim sID As Integer

    Dim app As Object
    Set app = GetObject(, "femap.model") 'Set model
    
    Dim WS As Worksheet
    Set WS = ThisWorkbook.Worksheets("Sheet1")

    rc = app.feDeleteAll(True, True, True, False) 'Delete old stuff
    
'Plane
    'Point #1
    Dim P As Object
    Set P = app.fePoint

    P.x = 0
    P.y = 0
    P.Z = 0
    
    ID = P.NextEmptyID
    rc = P.Put(ID)
    
    'Point #2
    P.x = WS.Cells(9, 3)
    P.y = 0
    P.Z = 0
    ID = P.NextEmptyID
    rc = P.Put(ID)

    'Line #1
    Dim Line As Object
    Set Line = app.feCurve
    
    Line.StdPoint(0) = P.PrevID
    Line.StdPoint(1) = P.NextEmptyID - 1

    ID = Line.NextEmptyID
    rc = Line.Put(ID)

'Web
    Dim i As Integer
    For i = 1 To WS.Cells(6, 3)
        'Point on plane
        P.x = WS.Cells(7, 3) / 2 + WS.Cells(7, 3) * (i - 1)
        P.y = 0
        P.Z = 0
        ID = P.NextEmptyID
        rc = P.Put(ID)
        
        'Point height web
        P.x = WS.Cells(7, 3) / 2 + WS.Cells(7, 3) * (i - 1)
        P.y = 0
        P.Z = WS.Cells(3, 3)
        ID = P.NextEmptyID
        rc = P.Put(ID)
        
        'Line web
        Line.StdPoint(0) = P.PrevID
        Line.StdPoint(1) = P.NextEmptyID - 1
    
        ID = Line.NextEmptyID
        rc = Line.Put(ID)
    Next
    
 'Flange
    For i = 1 To WS.Cells(6, 3)
        'Point west of flange
        P.x = WS.Cells(7, 3) / 2 + WS.Cells(7, 3) * (i - 1) - WS.Cells(4, 4) / 2
        P.y = 0
        P.Z = WS.Cells(3, 3)
        ID = P.NextEmptyID
        rc = P.Put(ID)
        
        'Point east of flange
        P.x = WS.Cells(7, 3) / 2 + WS.Cells(7, 3) * (i - 1) + WS.Cells(4, 4) / 2
        P.y = 0
        P.Z = WS.Cells(3, 3)
        ID = P.NextEmptyID
        rc = P.Put(ID)
        
        'Line flange
        Line.StdPoint(0) = P.PrevID
        Line.StdPoint(1) = P.NextEmptyID - 1
    
        ID = Line.NextEmptyID
        rc = Line.Put(ID)
    Next
    
'Create 3D model
    Dim curveSet1 As Object
    Set curveSet1 = app.feSet
    
    rc = curveSet1.Select(4, True, "Select") 'Select all curves
    curveSet1.ID = 1
    
    Dim dof(3) As Long
    Dim vdof As Variant
        
    dof(0) = 0
    dof(1) = -1
    dof(2) = 0
    vdof = dof
    
    rc = app.feSurfaceExtrude(1, 4500, vdof) '<-- does not work..
    
'Check

    If rc = -1 Then
        j = app.feAppMessage(1, "Done.")
    Else
        j = app.feAppMessage(3, "Failed.")
    End If

    app.feViewRegenerate (0)
    
End Sub 

Any help is welcome!

RE: FEMAP API - Extrude surface error

(OP)
Ok, solved it myself. Apparently there was something wrong with the datatype. The thread can be deleted if necessary.

CODE

'Create 3D model
    Dim curveSet1 As Object
    Set curveSet1 = app.feSet()
    
    rc = curveSet1.AddAll(4) 'Select all curves
    curveSet1.ID = 1
    
    Dim Dof(3) As Double
    Dim vDof As Variant
        
    Dof(0) = 0
    Dof(1) = 1
    Dof(2) = 0
    vDof = Dof
    
    rc = app.feSurfaceExtrude(1, 4500, vDof) 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources