Adjust orientation of CBUSH / spring in API

Creator
Creator

I was trying to amend this code to create the CBUSH or spring element with an orientation of the current/chosen properties coordinate system instead of a vector but after reading the provided API pdf I got no closer to my goal. 

I know that removing  El.orient(0) = VecP(0), El.orient(1) = VecP(1), El.orient(2) = VecP(2) defaults it to the global CSYS, but was wondering if what I ask is possible. 

Additionally, tried using El.orientID=P.refCS and it just set the orientation to be node 4 instead of the 4th csys.

 

The code creates two RBE elements with DOF1-3 restricted and then creates a CBUSH element at the midpoint of the two nodes. I would like to change the orientation of that element. I do not need the code to create a beam element so if removing the vector breaks that functionality that is no problem.

 

Any help would be appreciate, I tried to amend it to make it similar to the toolbox tool of creating Grounded Springs but was met with errors regarding integers. I really need it.

 

Included a picture of what Im referencing. 

 

Spring.png

 

 

' Author: Andy Haines, Siemens PLM
' Description: This macro allows creation of rigid elements and bars or springs
'              to represent a bolted joint.
' Date: 2013
' Reference: FS13-10_ExistingAPIs_SPLM_Haines.pdf, slide 27
Sub Main
    Dim App As femap.model
    Set App = feFemap()

    Dim Cu As femap.Curve
    Set Cu = App.feCurve

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

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

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

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

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

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

    Dim feNode As femap.Node
	Set feNode = App.feNode

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

	Dim feElem As femap.Elem
	Set feElem = App.feElem

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

	Dim El As femap.Elem
	Set El = App.feElem

	Dim P As femap.Prop
    Set P = App.feProp

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

    Dim listtype(0) As Long
    Dim entityID(0) As Long
    Dim FaceID(0) As Long
    Dim Expanded(0) As Long

    Dim BoReg(0) As Long
    Dim BoVal(0) As Double

    Dim Preload As Double

    Dim BeamElID As Long
    Dim PropID As Long
    Dim BeamID As Long
    Dim RAD As Double

    Dim cuCenter As Variant
	Dim cuNormal As Variant
	Dim cuStartPt As Variant
	Dim cuEndPt As Variant
	Dim cuAngle As Double
	Dim cuRadius As Double

	Dim nd1loc(2) As Double
	Dim nd2loc(2) As Double
	Dim dist As Double
	Dim DistCurrent As Double

	Dim pt1 As Long
	Dim pt2 As Long

	Dim nodeCount As Long
	Dim nodeX As Double
	Dim nodeY As Double
	Dim nodeZ As Double
	Dim nodeID As Long
	Dim elemID As Long
	Dim vNodeArray As Variant

	Dim BeamArea As Double
    Dim Vec(3) As Variant
    Dim X As Double
    Dim Y As Double
    Dim Z As Double
    Dim X1 As Double
    Dim Y1 As Double
    Dim Z1 As Double
    Dim VecP As Variant

	Dim feMatl As femap.Matl
    Set feMatl = App.feMatl
    Dim matID As Long

	'All the variables have been set by now
	'All the caveats
	Msg = "First node.."
    rc = MsgBox( Msg, vbOkOnly, "Caveats" )
	'The 3 gives users 3 options, Yes, No, Cancel, referring to RC 1-3 respectively
	'If I change the 3 to 2, then it would only display Yes or No, hitting esc still exits program
    rc = App.feAppMessageBox (3, "Select Existing Beam or Spring-CBUSH Property (No=Enter Bolt Radius)")
	'Ran if the user hits cancel or esc
    If rc=2 Then
    	GoTo Done
    End If

	'Runs if user hits no and desires to enter bolt radius
    If rc=0 Then

    	matID = App.Info_ActiveID( FT_MATL )

    	If matID = 0 Then
    		Msg = "No active material for fastener, please activate a material and re-run."
        	rc = MsgBox( Msg, vbOkOnly, "No Material" )
        	GoTo Done
    	End If

    	rc = feMatl.Get( matID )

		'Section Values A

		Radagain:

		rc = App.feGetReal ("Enter Bolt Radius", 0.000000001, 1000000, RAD)
		If rc = 2 Then
			GoTo Done
		End If

		PropID = P.NextEmptyID
		P.title = "API Fastener"
    	P.type = FET_L_BEAM
    	P.flagI(1) = 5
    	P.pval (40) = RAD
    	P.ComputeShape (False, False, True)
    	P.matlID = matID
    	P.Put(PropID)
    	Proptype = P.type

	'Runs if the user hits yes
    Else
    	'Returns to this point if property has no CSYS or is not a CBUSH/Spring/Beam
    	again:
    	rc = pset.SelectID (FT_PROP, "Select Property for Bolt", PropID)
    	'If the user hits cancel after selecting to use existing property
    	If rc = 2 Then
			GoTo Done
		End If
    	P.Get (PropID)
    	proptype = P.type
    	If proptype <> 5 Then
    		If proptype = 6 Then
    			isBush = P.flag(3)
    			If isBush = True Then
					refCSYS = P.flag(0)
					If refCSYS = True Then
						'Ideally, if the property was created correctly, this will allow a jump to curve selection
						GoTo MoveOn
					Else
						rc = App.feAppMessageBox (1, "Selected Spring Property does not have Orientation CSys defined.  Select Different Property?")
						If rc = 2 Then
							GoTo Done
						Else
							GoTo Again
						End If
					End If
				Else
				rc = App.feAppMessageBox (1, "Selected Spring Property is not set to CBUSH.  Select Different Property?")
				If rc = 2 Then
					GoTo Done
				Else
					GoTo Again
				End If
			End If
    		Else
    			rc = App.feAppMessageBox (1, "Selected Property is not a Beam or Spring Property.  Select Different Property?")
				If rc = 2 Then
					GoTo Done
				Else
					GoTo Again
				End If
			End If
    	End If
	End If

	MoveOn:

    cuSet.Select (FT_CURVE, True, "Select Curves for Bolts")

    cuID = cuSet.First

    While cuID > 0
    	Cu.Get(cuID)
    	rc = Cu.ArcCircleInfo( cuCenter, cuNormal, cuStartPt, cuEndPt, cuAngle, cuRadius )
		If rc = FE_OK Then
			CircSet.Add (cuID)
		End If
		cuID = cuSet.Next
    Wend

    CircID = CircSet.First

    While CircID > 0
    	Cu.Get(CircID)
		Cu.EndPoints (pt1, pt2)
		CircSubSet.AddRule (pt1, FGD_CURVE_BYPOINT)
		CircSubSet.AddRule (pt2, FGD_CURVE_BYPOINT)
		CircSubID = CircSubSet.First
			While CircSubID > 0
				Cu.Get(CircSubID)
				Cu.EndPoints (pt1, pt2)
				CircSubSet.AddRule (pt1, FGD_CURVE_BYPOINT)
				CircSubSet.AddRule (pt2, FGD_CURVE_BYPOINT)
				CircSubID = CircSubSet.Next
			Wend
			FinSet.AddCommon (CircSet.ID, CircSubSet.ID)
			CuNum = FinSet.Count
			PointSet.AddSetRule (FinSet.ID, FGD_POINT_ONCURVE)
			PtNum = PointSet.Count
			If CuNum <> PtNum Then
				GoTo Skip
			End If

	' Get a set of nodes for this rigid element

    rc = nodeSet.AddSetRule( FinSet.ID, FGD_NODE_ATCURVE )

    If nodeSet.Count = 0 Then
    App.feAppMessageBox (0, "No nodes exist on a selected curve(s).  Exiting...")
    	GoTo Jumping_Out
    End If

    'Lets see how many nodes were selected
    nodeCount = nodeSet.Count()

    If nodeCount > 0 Then
        ' Walk the nodes and find the average
        rc = nodeSet.Reset()
        nodeID = nodeSet.Next()
        ReDim nodeArray(nodeCount) As Long

        Dim passCount As Long

        passCount = 0

        Do While nodeID <> 0

            nodeArray(passCount) = nodeID
            passCount = passCount + 1
            rc = feNode.Get(nodeID)

            nodeX = nodeX + feNode.x
            nodeY = nodeY + feNode.y
            nodeZ = nodeZ + feNode.z

            nodeID = nodeSet.Next()

        Loop

        vNodeArray = nodeArray

        nodeID = feNode.NextEmptyID

        feNode.ID = nodeID
        feNode.x = nodeX / nodeCount
        feNode.y = nodeY / nodeCount
        feNode.z = nodeZ / nodeCount

        rc = feNode.Put(nodeID)
        IndNdSet.Add (nodeID)

        If rc = -1 Then 'return code FE_OK
            ' create the element

            elemID = feElem.NextEmptyID
			feElem.type = FET_L_RIGID
			feElem.topology = FTO_RIGIDLIST

            feElem.Node(0) = nodeID 'Independent Node
            feElem.release(0, 0) = 1 'Locks the DOF of the Rigid Elements
            feElem.release(0, 1) = 1
            feElem.release(0, 2) = 1
            feElem.release(0, 3) = 1
            feElem.release(0, 4) = 1
            feElem.release(0, 5) = 1

            feElem.ID = elemID

	        rc = feElem.PutNodeList(0, nodeCount, vNodeArray, Null, Null, Null)
            rc = feElem.Put(elemID)

    	nodeCount = 0

	    rc = nodeSet.Clear()

		nodeX = 0#
		nodeY = 0#
		nodeZ = 0#
        End If
    End If
    	Skip:
    	PointSet.Clear
		CircSet.RemoveSet (FinSet.ID)
		FinSet.Clear
		CircSubSet.Clear
		CircID = CircSet.Next
    Wend

   If IndNdSet.Count = 1 Then
    	Nd1 = IndNdSet.First
    		DeleteSet.AddRule (nd1, FGD_ELEM_BYNODE)
    		feElem.Delete (DeleteSet.First)
    		feNode.Delete (Nd1)
    		GoTo Jumping_Out
    End If

    nd1 = IndNdSet.First
    While nd1 > 0
    	feNode.Get(nd1)
    	nd1loc(0) = feNode.x
    	nd1loc(1) = feNode.y
    	nd1loc(2) = feNode.z
    	DistCurrent = 1000000.0
		nd2 = IndNdSet.Next
		IndNdSet.Remove (nd1)
		While nd2 > 0
			feNode.Get(nd2)
    		nd2loc(0) = feNode.x
    		nd2loc(1) = feNode.y
    		nd2loc(2) = feNode.z
    		App.feMeasureDistance (nd1loc, nd2loc, dist)
    		If DistCurrent > dist Then
    			DistCurrent = dist
    			nd2Keep = nd2
    		End If
			nd2 = IndNdSet.Next
		Wend
		IndNdSet.Remove (nd2keep)
		IndNdSet.Reset

		BeamElID = El.NextEmptyID
		If Proptype = 5 Then
    		El.type = FET_L_BEAM
    	Else
    		El.type = FET_L_SPRING
    	End If
    	El.Node (0) = nd1
    	El.Node (1) = nd2Keep
    	'This is him getting the coordinates of the points and creating a vector
   		Msg = "Check 1"
	    rc = MsgBox( Msg, vbOkOnly, "Caveats" )
	    'Grabs the coordinates of the first node
    	rc = feNode.Get (nd1)
    	X = feNode.x
    	Y = feNode.y
    	Z = feNode.z
    	'Grabs Coordinates of the 2nd node
    	rc = feNode.Get (nd2Keep)
    	X1 = feNode.x
    	Y1 = feNode.y
    	Z1 = feNode.z
    	Vec(0) = X - X1
    	Vec(1) = Y - Y1
    	Vec(2) = Z - Z1
    	rc = App.feVectorPerpendicular (Vec, VecP)
    	El.orient(0) = VecP(0)
    	El.orient(1) = VecP(1)
    	El.orient(2) = VecP(2)
    	El.propID = PropID
    	El.Put (BeamElID)

    	If proptype = 6 Then
   			Msg = "Check 2"
	    	rc = MsgBox( Msg, vbOkOnly, "Caveats" )
    		newx = (X + X1) / 2
    		newy = (Y + Y1) / 2
    		newz = (Z + Z1) / 2

	    	feNode.x = newx
    		feNode.y = newy
    		feNode.z = newz

	    	rc = feNode.Put(nd1)
    		rc = feNode.Put(nd2Keep)
    	End If

    	If IndNdSet.Count = 1 Then
    		'If Everything Runs Properly when Creating a String, This Doesn't Run
    		Msg = "Check 3"
	    	rc = MsgBox( Msg, vbOkOnly, "Caveats" )
    		Nd1 = IndNdSet.First
    			DeleteSet.AddRule (nd1, FGD_ELEM_BYNODE)
    			feElem.Delete (DeleteSet.First)
    			feNode.Delete (Nd1)
    		GoTo Jumping_Out
    	End If

		nd1 = IndNdSet.First
    Wend

    Jumping_Out:

	Call App.feViewRegenerate(0)

	Done:

End Sub

 

3 REPLIES 3
Highlighted

Re: Adjust orientation of CBUSH / spring in API

Siemens Phenom Siemens Phenom
Siemens Phenom

There is a .SetSpringOrient Method on the feElem object, the first argument being the orientation method, set this to 4, and the CBUSH element will get its orientation CSys from its propertry -

 

Here is my test API that converted a Node oriented CBUSH to a Property CSys oriented one that works -

 

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

    Dim feElem As femap.Elem
    Set feElem = App.feElem

    feElem.Get(1)

    Dim enOrient As Long
    Dim nOrient As Long
    Dim v1 As Double
    Dim v2 As Double
    Dim v3 As Double

    enOrient = 4


    feElem.SetSpringOrient( 4, 0, 0.0, 0.0, 0.0 )
    feElem.Put(1)

    
End Sub

Re: Adjust orientation of CBUSH / spring in API

Creator
Creator

Thankyou for the help

Re: Adjust orientation of CBUSH / spring in API

Gears Phenom Gears Phenom
Gears Phenom

Hello MarioBla,

 

here is my API to creating bolt between two surfaces with rigid and 2D elements, you can try it:

 

'Create Bolt between two Surfaces with Rigid Elements
Dim App As femap.model
Dim layerSet As femap.Set
Dim surfaceSet As femap.Set
Dim allCurveSet As femap.Set
Dim newCurveSet As femap.Set
Dim nodeSet1 As femap.Set
Dim nodeSet2 As femap.Set
Dim feLayer As femap.layer
Dim feSurface1 As femap.Surface
Dim feSurface2 As femap.Surface
Dim feCurve As femap.Curve
Dim fePoint1 As femap.Point
Dim fePoint2 As femap.Point
Dim feProp As femap.Prop
Dim feElem As femap.Elem
Dim feRigid1 As femap.Elem
Dim feRigid2 As femap.Elem
Dim feNode1 As femap.Node
Dim feNode3 As femap.Node
Dim activeLayerID As Long
Dim curveLayerID As Long
Dim rigidLayerID As Long
Dim activePropID As Long
Dim barPropID As Long
Dim surfaceID1 As  Long
Dim surfaceID2 As  Long
Dim curveID As Long
Dim pointID1 As Long
Dim pointID2 As Long
Dim elemID As Long
Dim RigidID1 As Long
Dim RigidID2 As Long
Dim nodeID1 As Long
Dim nodeID2 As Long
Dim nodeID3 As Long
Dim tmpNodeID As Long
Dim layerCount As Long
Dim layerTitle As Variant
Dim layerID As Variant
Dim propCount As Long
Dim propTitle As Variant
Dim propID As Variant
Dim ListArray_Curve() As String
Dim ListArray_Rigid() As String
Dim ListArray_BarProp() As String
Dim ListArray_Space(4) As String
Dim List_CurveID As Long
Dim List_RigidID As Long
Dim List_BarPropID() As Long
Dim List_BarPropIndex As Long
Dim SpaceValue As Double
Dim elemType As Long
Dim ptCoord1 As Variant
Dim ptCoord2 As Variant
Dim pt1(2) As Double
Dim pt2(2) As Double
Dim dist(2) As Double
Dim vecLength As Double
Dim vecBase As Variant
Dim vecDir As Variant
Dim vec(2) As Double
Dim vecP(2) As Double
Dim nodeArray() As Long
Dim bExit As Boolean
Dim bVector As Boolean
Dim index As Integer

Sub Main

	Set App = feFemap()
	Set layerSet=App.feSet
	Set surfaceSet = App.feSet
	Set allCurveSet = App.feSet
	Set newCurveSet = App.feSet
	Set nodeSet1 = App.feSet
	Set nodeSet2 = App.feSet
	Set feLayer = App.feLayer
	Set feSurface1 = App.feSurface
	Set feSurface2 = App.feSurface
	Set feCurve = App.feCurve
	Set fePoint1 =App.fePoint
	Set fePoint2 = App.fePoint
	Set feProp = App.feProp
	Set feElem =App.feElem
	Set feRigid1 =App.feElem
	Set feRigid2 =App.feElem
	Set feNode1 = App.feNode
	Set feNode2 = App.feNode
	Set feNode3 = App.feNode
	bExit =False
	bVector=False

	App.feAppMessage( FCM_COMMAND, "Create Bolt between two Surfaces with Rigid Elements")

	If App.Info_Count(FT_SURFACE)<2 Then
		App.feAppMessage( FCM_ERROR, "Count of Surfaces are less then two - Cancelled")
		App.feViewRegenerate( 0 )
		Exit Sub
	End If

	activeLayerID=App.Info_ActiveID(FT_LAYER)
	curveLayerID=activeLayerID
	rigidLayerID=activeLayerID
	rc = feLayer.GetTitleIDList(False, 0, 0, layerCount, layerID, layerTitle)

	ReDim ListArray_Curve(layerCount)
	ReDim ListArray_Rigid(layerCount)
	For i=1 To layerCount
		ListArray_Curve(i)=CStr(layerID(i-1))+".."+layerTitle(i-1)
		ListArray_Rigid(i)=CStr(layerID(i-1))+".."+layerTitle(i-1)
		If layerID(i-1)=activeLayerID Then
			List_CurveID=i
			List_RigidID=i
		End If
	Next

	List_BarPropIndex=0
	activePropID=App.Info_ActiveID(FT_PROP)
	barPropID=activePropID
	rc = feProp.GetTitleIDList(False, 0, 0, propCount, propID, propTitle)
	ReDim ListArray_BarProp(0)
	If propCount<>0 Then
		index=0
		For i=1 To propCount
			rc=feProp.Get(propID(i-1))
			elemType=feProp.type
			If feProp.type=FET_L_BAR Or feProp.type= FET_L_TUBE Or feProp.type=FET_L_BEAM  _
					Or feProp.type=FET_L_ROD Or feProp.type=FET_P_BEAM Then
				index=index+1
				ReDim Preserve ListArray_BarProp(index)
				ReDim Preserve List_BarPropID(index)
				ListArray_BarProp(index)=CStr(propID(i-1))+".."+propTitle(i-1)
				List_BarPropID(index)=propID(i-1)
				If propID(i-1)=activePropID Then
					List_BarPropIndex=index
				End If
			End If
		Next
		If UBound(ListArray_BarProp)>0 And List_BarPropIndex=0 Then List_BarPropIndex=1
	End If

	ListArray_Space(1)="5"
	ListArray_Space(2)="10"
	ListArray_Space(3)="15"
	ListArray_Space(4)="20"

	Begin Dialog UserDialog 100,600,580,225,"Select Layer",.dlg ' %GRID:10,5,1,1
		OKButton 60,182,90,21
		DropListBox 120,20,280,65,ListArray_Curve(),.DropList_CurveLayer
		DropListBox 120,55,280,65,ListArray_Rigid(),.DropList_RigidLayer
		DropListBox 120,95,280,65,ListArray_BarProp(),.DropList_BarProp
		PushButton 210,182,90,21,"Cancel",.btnCancel
		text 20,22,90,15,"Bolt Layer:",.Text1
		text 410,22,70,15,"Space [%]",.Text4
		text 20,57,90,14,"Rigid Layer:",.Text2
		text 20,95,100,30,"Bolt Line Elem. Property:",.Text3
		PushButton 420,95,120,30,"Set Vector (Auto)",.btnVector
		DropListBox 490,20,50,65,ListArray_Space(),.DropList_Space
	End Dialog
	Dim dlg As UserDialog

DIALOG_BEGIN:
	Dialog dlg

	If bExit Then Exit Sub

SELECT_SURFACE:
	rc = surfaceSet.Select( FT_SURFACE, True, "Select Surfaces to Create Bolt (Cancel for Exit)")
	If rc=FE_CANCEL Then Exit Sub
	If surfaceSet.Count<>2 Then
		App.feAppMessage( FCM_ERROR, "No two Surfaces are selected - Cancelled")
		App.feViewRegenerate( 0 )
		Exit Sub
	End If

	surfaceID1=surfaceSet.First
	surfaceID2=surfaceSet.Last
	rc=feSurface1.Get(surfaceID1)
	rc=feSurface2.Get(surfaceID2)
	rc=feSurface1.cg(ptCoord1)
	rc=feSurface2.cg(ptCoord2)

	rc=nodeSet1.Clear
	rc=nodeSet1.AddRule( surfaceID1, FGD_NODE_ATSURFACE)
	rc=nodeSet2.Clear
	rc=nodeSet2.AddRule( surfaceID2, FGD_NODE_ATSURFACE)

	bExit=False
	If nodeSet1.Count=0 And nodeSet2.Count=0 Then
		rc=MsgBox ("There aren't any Nodes on selected Surfaces" & vbCrLf & vbCrLf & "Do you want to continue?", _
			vbYesNo, "Create Bolt between two Surfaces with Rigid Elements")
		If rc=vbNo Then bExit=True
	End If
	If (nodeSet1.Count=0 And nodeSet2.Count<>0) Or (nodeSet1.Count<>0 And nodeSet2.Count=0)Then
		rc=MsgBox ("There aren't any Nodes on one of selected Surfaces" & vbCrLf & vbCrLf & "Do you want to continue?", _
			vbYesNo, "Create Bolt between two Surfaces with Rigid Elements")
		If rc=vbNo Then bExit=True
	End If

	If bExit Then
		App.feAppMessage( FCM_ERROR, "Cancelled by User")
		App.feViewRegenerate( 0 )
		Exit Sub
	End If

	For i=0 To 2
		pt1(i)=ptCoord1(i)
		pt2(i)=ptCoord2(i)
	Next
	dist(0)=SpaceValue*(pt2(0)-pt1(0))
	dist(1)=SpaceValue*(pt2(1)-pt1(1))
	dist(2)=SpaceValue*(pt2(2)-pt1(2))
	pt1(0)=pt1(0)+dist(0)
	pt1(1)=pt1(1)+dist(1)
	pt1(2)=pt1(2)+dist(2)
	pt2(0)=pt2(0)-dist(0)
	pt2(1)=pt2(1)-dist(1)
	pt2(2)=pt2(2)-dist(2)
	For i=0 To 2
		ptCoord1(i)=pt1(i)
		ptCoord2(i)=pt2(i)
	Next

	pointID1=fePoint1.NextEmptyID
	fePoint1.xyz=ptCoord1
	fePoint1.layer=curveLayerID
	rc=fePoint1.Put(pointID1)

	pointID2=fePoint2.NextEmptyID
	fePoint2.xyz=ptCoord2
	fePoint2.layer=curveLayerID
	rc=fePoint2.Put(pointID2)

	rc= allCurveSet.Clear
	rc= newCurveSet.Clear
	rc=allCurveSet.AddAll( FT_CURVE )
	rc=App.feLinePointIDs(pointID1, pointID2, True)
	rc=newCurveSet.AddAll( FT_CURVE )
	rc= newCurveSet.RemoveSet(allCurveSet.ID )
	If newCurveSet.Count<>1 Then
		Exit Sub
	End If

	curveID=newCurveSet.First
	rc=feCurve.Get(curveID)
	feCurve.layer=curveLayerID
	rc=feCurve.Put(curveID)

	nodeID1=feNode1.NextEmptyID
	feNode1.xyz=ptCoord1
	feNode1.layer=curveLayerID
	rc=feNode1.Put(nodeID1)

	nodeID2=feNode2.NextEmptyID
	feNode2.xyz=ptCoord2
	feNode2.layer=curveLayerID
	rc=feNode2.Put(nodeID2)

	elemID=feElem.NextEmptyID
	feElem.type=elemType
	feElem.propID=barPropID
	feElem.layer=curveLayerID
	feElem.Node(0)=nodeID1
	feElem.Node(1)=nodeID2
	If elemType=FET_P_BEAM Then	'Parabolic Beam
		nodeID3=feNode3.NextEmptyID
		feNode3.x=(feNode1.x+feNode2.x)/2
		feNode3.y=(feNode1.y+feNode2.y)/2
		feNode3.z=(feNode1.z+feNode2.z)/2
		feNode3.layer=curveLayerID
		rc=feNode3.Put(nodeID3)
		feElem.Node(2)=nodeID3
		feElem.topology=FTO_LINE3
	Else
		feElem.topology=FTO_LINE2
	End If

	If bVector Then
		feElem.orient(0)=vecDir(0)
		feElem.orient(1)=vecDir(1)
		feElem.orient(2)=vecDir(2)
	Else
		vec(0)=pt2(0)-pt1(0)
		vec(1)=pt2(1)-pt1(1)
		vec(2)=pt2(2)-pt1(2)
		Call FindPerpindicularVector(vec(0), vec(1), vec(2), vecP(0), vecP(1), vecP(2))
		feElem.orient(0)=vecP(0)
		feElem.orient(1)=vecP(1)
		feElem.orient(2)=vecP(2)
	End If
	rc=feElem.Put(elemID)
	If rc=FE_FAIL Then MsgBox "Fail"

	rc=App.feMeshAttach(FT_ELEM, -elemID, FT_CURVE, curveID, True)
	If rc=FE_FAIL Then	MsgBox "Element or Nodes can't be attached to Curve"

	If nodeSet1.Count>0 Then
		ReDim nodeArray(nodeSet1.Count-1)
		tmpNodeID=nodeSet1.First
		For i=1 To nodeSet1.Count
			nodeArray(i-1)=tmpNodeID
			tmpNodeID=nodeSet1.Next
		Next

		RigidID1=feRigid1.NextEmptyID
		feRigid1.type=FET_L_RIGID
		feRigid1.topology=FTO_RIGIDLIST
		feRigid1.layer=rigidLayerID
		feRigid1.color=FCL_YELLOW
		feRigid1.Node(0)=nodeID1	'Independent Node
		feRigid1.release(0, 0)=True
		feRigid1.release(0, 1)=True
		feRigid1.release(0, 2)=True
		feRigid1.release(0, 3)=True
		feRigid1.release(0, 4)=True
		feRigid1.release(0, 5)=True
		rc=feRigid1.PutNodeList(0,UBound(nodeArray)+1, nodeArray, Null, Null, Null)
		rc=feRigid1.Put(RigidID1)
		If rc=FE_FAIL Then MsgBox "Unable to create the first Rigid Element"
	End If

	If nodeSet2.Count>0 Then
		ReDim nodeArray(nodeSet2.Count-1)
		tmpNodeID=nodeSet2.First
		For i=1 To nodeSet2.Count
			nodeArray(i-1)=tmpNodeID
			tmpNodeID=nodeSet2.Next
		Next

		RigidID2=feRigid2.NextEmptyID
		feRigid2.type=FET_L_RIGID
		feRigid2.topology=FTO_RIGIDLIST
		feRigid2.layer=rigidLayerID
		feRigid2.color=FCL_YELLOW
		feRigid2.Node(0)=nodeID2	'Independent Node
		feRigid2.release(0, 0)=True
		feRigid2.release(0, 1)=True
		feRigid2.release(0, 2)=True
		feRigid2.release(0, 3)=True
		feRigid2.release(0, 4)=True
		feRigid2.release(0, 5)=True
		rc=feRigid2.PutNodeList(0,UBound(nodeArray)+1, nodeArray, Null, Null, Null)
		rc=feRigid2.Put(RigidID2)
		If rc=FE_FAIL Then MsgBox "Unable to create the second Rigid Element"
	End If
	App.feViewRegenerate( 0 )
	GoTo SELECT_SURFACE

End Sub

Rem See DialogFunc help topic for more information.
Private Function dlg(DlgItem$, Action%, SuppValue?) As Boolean
	Select Case Action%
	Case 1 ' Dialog box initialization
		DlgValue "DropList_CurveLayer", List_CurveID
		DlgValue "DropList_RigidLayer", List_RigidID
		DlgValue "DropList_BarProp", List_BarPropIndex
		DlgValue "DropList_Space", 3
		SpaceValue=Val(DlgText ("DropList_Space"))/100
		If UBound(ListArray_BarProp)=0 Then
			DlgEnable "DropList_BarProp",False
			DlgEnable "OK",False
		Else
			DlgEnable "DropList_BarProp",True
			DlgEnable "OK",True
			List_BarPropIndex=DlgValue ("DropList_BarProp")
			barPropID=List_BarPropID(List_BarPropIndex)
			rc=feProp.Get(List_BarPropID(List_BarPropIndex))
			elemType=feProp.type
		End If
	Case 2 ' Value changing or button pressed
		If DlgItem$="DropList_CurveLayer" Then
			curveLayerID=layerID(DlgValue ("DropList_CurveLayer")-1)
		End If
		If DlgItem$="DropList_RigidLayer" Then
			rigidLayerID=layerID(DlgValue ("DropList_RigidLayer")-1)
		End If
		If DlgItem$="DropList_BarProp" Then
			List_BarPropIndex=DlgValue ("DropList_BarProp")
			barPropID=List_BarPropID(List_BarPropIndex)
			rc=feProp.Get(List_BarPropID(List_BarPropIndex))
			elemType=feProp.type
		End If
		If DlgItem$="DropList_Space" Then
			SpaceValue=Val(DlgText ("DropList_Space"))/100
		End If


		If DlgItem$="OK" Then
			'App.feViewRegenerate( 0 )
		End If
		If DlgItem$="btnCancel" Then
			App.feAppMessage( FCM_ERROR, "Cancelled")
			App.feViewRegenerate( 0 )
			bExit=True
		End If
		If DlgItem$="btnVector" Then
			rc=App.feVectorPick("Select Vector", True, vecLength, vecBase, vecDir)
			If rc<>FE_CANCEL Then
				DlgText "btnVector", "Set Vector (On)"
				bVector=True
			End If
			dlg=True
		End If
		Rem dlg = True ' Prevent button press from closing the dialog box
	Case 3 ' TextBox or ComboBox text changed
	Case 4 ' Focus changed
	Case 5 ' Idle
		Rem Wait .1 : dlg = True ' Continue getting idle actions
	Case 6 ' Function key
	End Select
End Function

Sub FindPerpindicularVector(ByRef v10 As Double, ByRef v11 As Double, ByRef v12 As Double, ByRef v20 As Double, ByRef v21 As Double, ByRef v22 As Double)

    Dim length As Double
    Dim v41 As Double
    Dim v42 As Double
    Dim v43 As Double
    Dim v31 As Double
    Dim v32 As Double
    Dim v33 As Double
    length = Sqr(v10 * v10 + v11 * v11 + v12 * v12)

    v10 = v10 / length
    v11 = v11 / length
    v12 = v12 / length

    ' check for alignment with global axes

    If Abs(v10) < 0.00000001 Then
        'yz return x
        v20 = 1#
        v21 = 0#
        v22 = 0#
        GoTo done
    End If

    If Abs(v11) < 0.00000001 Then
        'xz return y
        v20 = 0#
        v21 = 1#
        v22 = 0#
        GoTo done
    End If

    If Abs(v12) < 0.00000001 Then
        'yz return z
        v20 = 0#
        v21 = 0#
        v22 = 1#
        GoTo done
    End If

    If Abs(v10 - 1#) < 0.00000001 Then
        v20 = 0#
        v21 = 1#
        v22 = 0
        GoTo done
    End If

    If Abs(v11 - 1#) < 0.00000001 Then
        v20 = 1#
        v21 = 0#
        v22 = 0
        GoTo done
    End If

    If Abs(v12 - 1#) < 0.00000001 Then
        v20 = 0#
        v21 = 1#
        v22 = 0#
        GoTo done
    End If

    If v10 > 0.9 Then 'Mostly x cross with z
        v41 = v10
        v42 = v11
        v43 = v12
        v31 = 0#
        v32 = 0#
        v33 = 1#
        v20 = v42 * v33 - v32 * v43
        v21 = v31 * v43 - v41 * v33
        v22 = v41 * v32 - v31 * v42
        GoTo done
    Else
        v41 = v10
        v42 = v11
        v43 = v12
        v31 = 1#
        v32 = 0#
        v33 = 0#
        v20 = v42 * v33 - v32 * v43
        v21 = v31 * v43 - v41 * v33
        v22 = v41 * v32 - v31 * v42
        GoTo done
    End If

done:

length = Sqr(v20 * v20 + v21 * v21 + v22 * v22)

v20 = v20 / length
v21 = v21 / length
v22 = v22 / length

End Sub

Best regards

 

Peter Kaderasz