Rhino

The following two scripts show how to export Rhino drawings into GSA.

We first create a mesh object from self-intersecting, planar curves. The mesh information, namely vertices and edges, are then written in GWA format, which can be imported to GSA.

1. Create a mesh object out of a set of curves

Option Explicit ' Giovani Estrada, 30.04.2012 ' ' It takes a set of self-intersecting curves and convert them to a single mesh object ' ' Note: ' Rhino gets in problems when the curves intersect in the origin (0,0,0), ' or are aligned to the main axes ' Call Main() Sub Main() Dim aObjects, aPoints, aCurves, aList ' is there anything selected? aObjects = Rhino.SelectedObjects If IsNull(aObjects) Then ' no? then ask aObjects = Rhino.GetObjects("Pick the curves to be converted", 4) End If Rhino.SelectObjects aObjects If Not IsArray(aObjects) Then Exit Sub ' got something? ' cut the curves into segments and points cutThem aObjects, aPoints, aCurves ' is there anything there to be processed? If (Not IsArray(aPoints)) Or (Not IsArray(aCurves)) Then Exit Sub ' for faster visualisation Rhino.EnableRedraw False ' find quads, save and display them aList = AdjacencyList(aCurves, aPoints) connectFaces aList, aPoints ' clean up temporary objects Rhino.Command "_-SelGroup CurvesGrp _Delete" ' delete grouped objects Rhino.DeleteGroup "CurvesGrp" ' delete empty group Rhino.EnableRedraw True End Sub ' ' look for triangular and quadrangular faces ' ' IN : adjacency list ' IN : array of nodal coordinates ' OUT : a single mesh, connecting all faces without repetitions Sub connectFaces(aList, aPoints) ' get the adjacency list Dim i, j, k, l, aNodes, arrUniqueFaces, iType, hashID ' initialise the list of unique faces and its hash IDs ReDim arrUniqueFaces(-1) ReDim hashID(-1) ' a loop through the adjacency list For i=0 To UBound(aList) aNodes = aList(i) ' 1st order neighbours ' select all pairs (without repetition) of incident vertices For j=0 To UBound(aNodes)-1 For k=j+1 To UBound(aNodes) iType = IsPanel(aList(i), aList(aNodes(j)), aList(aNodes(k)), i, aNodes(j), l) Select Case iType Case 1 ' triangle ijk myAddMesh aPoints, Array(i, aNodes(j), aNodes(k), aNodes(k)), arrUniqueFaces, hashID Case 2 ' quad ijlk myAddMesh aPoints, Array(i, aNodes(j), l, aNodes(k)), arrUniqueFaces, hashID Case 3 ' triangles ijl & ikl myAddMesh aPoints, Array(i, aNodes(j), l, l), arrUniqueFaces, hashID myAddMesh aPoints, Array(i, aNodes(k), l, l), arrUniqueFaces, hashID End Select Next Next Next ' create a mesh with all faces Rhino.UnselectAllObjects Rhino.SelectObjects arrUniqueFaces Rhino.Command "_-Join _SelLast _PointsOn _SelPt _WeldVertices _PointsOff" End Sub ' custom AddMesh : it check for repeated faces ' ' IN : aPoints ' IN : ijlk : face vertices, set l=t for a triangle ' IN/OUT : arrUniqueFaces, hashID Sub myAddMesh(aPoints, arrFaceVertices, arrUniqueFaces, hashID) Dim i, tentative, strMesh, arrFace(3) ' hash function with the face vertices, notice array index starts in zero ' use another (less naive) integer hash function if found missing MeshFaces If (arrFaceVertices(2)=arrFaceVertices(3)) Then tentative = (arrFaceVertices(0)+1) * (arrFaceVertices(1)+1) * (arrFaceVertices(2)+1) Else tentative = (arrFaceVertices(0)+1) * (arrFaceVertices(1)+1) * (arrFaceVertices(2)+1) * (arrFaceVertices(3)+1) End If ' is it repeated? For i=0 To UBound(hashID) If (hashID(i)=tentative) Then Exit Sub Next ' mapping from vertices to coordinates arrFace(0) = aPoints(arrFaceVertices(0)) arrFace(1) = aPoints(arrFaceVertices(1)) arrFace(2) = aPoints(arrFaceVertices(2)) arrFace(3) = aPoints(arrFaceVertices(3)) ' AddMesh can create triangles or quads, depending on the last digit in its last parameter If (arrFaceVertices(2)=arrFaceVertices(3)) Then strMesh = Rhino.AddMesh(arrFace, Array(Array(0, 1, 2, 2))) ' triangle Else strMesh = Rhino.AddMesh(arrFace, Array(Array(0, 1, 2, 3))) ' quad End If ' successfully created mesh? included in the list of unique faces If Not IsNull(strMesh) Then ReDim Preserve arrUniqueFaces(UBound(arrUniqueFaces)+1) ReDim Preserve hashID(UBound(hashID)+1) arrUniqueFaces(UBound(arrUniqueFaces)) = strMesh hashID(UBound(hashID)) = tentative ' meshID as a hash function End If End Sub ' ' check whether the points create a triangle, a square ' or a square containing two triangles ' Function IsPanel(Set_i, Set_j, Set_k, i, j, l) Dim elem_j, elem_k IsPanel = 0 ' default case : no panel ' 1st case : triangle ijk ' a direct link between nodes j and k If IsMember(j, Set_k) Then IsPanel = 1 Exit Function End If ' 2nd case : quad ijlk ' l = (Set_j intersection Set_k) - {i} l = -1 For Each elem_j In Set_j For Each elem_k In Set_k If (elem_j = elem_k) And (elem_j <> i) Then l = elem_j IsPanel = 2 End If Next Next ' 3rd case : the quad ijlk has segment il ' the quad is actually a set of two triangles If (l <> -1) Then If IsMember(l, Set_i) Then IsPanel = 3 End If End If End Function ' ' does number "a" belong to "aSet"? ' Function IsMember(a, aSet) Dim element ' is "member" in "aSet"? For Each element In aSet If (element=a) Then IsMember=1 Exit Function ' return true End If Next IsMember = 0 ' search ends in false End Function ' ' Standardise the numerical tolerance, some functions do not ' behave similarly in Rhino 4 or 5 ' Sub SetTolerance Dim dblAbsTol, dblRelTol, dblAngleTol dblAbsTol = Rhino.UnitAbsoluteTolerance If dblAbsTol < 0.01 Then Rhino.UnitAbsoluteTolerance 0.01 dblRelTol = Rhino.UnitRelativeTolerance If dblRelTol < 1.0 Then Rhino.UnitRelativeTolerance 1.0 dblAngleTol = Rhino.UnitAngleTolerance If dblAngleTol < 3.0 Then Rhino.UnitAngleTolerance 3.0 End Sub ' ' cut the curves against their own intersections ' (temporary objects are grouped : CurvesGrp & PtsGrp) ' Sub cutThem(aObjects, aPoints, aCurves) Dim element, strGroup, i, tmpPoints ' Set a default tolerance for compatibility reasons SetTolerance ' curves to be processed strGroup = "CurvesGrp" Rhino.DeleteGroup strGroup Rhino.AddGroup(strGroup) Rhino.AddObjectsToGroup Rhino.SelectedObjects, strGroup ' get their intersections & group them strGroup = "PtsGrp" Rhino.DeleteGroup strGroup Rhino.Command "_-Intersect" Rhino.AddGroup(strGroup) Rhino.AddObjectsToGroup Rhino.SelectedObjects, strGroup ' get the points tmpPoints = Rhino.LastCreatedObjects If Not IsArray(tmpPoints) Then Exit Sub tmpPoints = Rhino.CullDuplicateStrings(tmpPoints) ' cut the curves at those points Rhino.Command "_-Split -SelGroup CurvesGrp _Enter -SelGroup PtsGrp _Enter" aCurves = Rhino.LastCreatedObjects If Not IsArray(aCurves) Then Exit Sub aCurves = Rhino.CullDuplicateStrings(aCurves) ' get the coordinates of those points If IsArray(tmpPoints) Then ReDim aPoints(UBound(tmpPoints)) For i=0 To UBound(tmpPoints) aPoints(i) = Rhino.PointCoordinates(tmpPoints(i)) Next ' delete the temporary variable, cull duplicate points Rhino.DeleteObjects tmpPoints aPoints = Rhino.CullDuplicatePoints(aPoints) End If Rhino.DeleteGroup "PtsGrp" ' delete empty group End Sub ' ' Adjacency list for easy access of node-to-node connections ' (list 1st order neighbourhood of points) ' ' IN : list of curves ' IN : nodal coordinates ' Return : adjacency list Function AdjacencyList(aCurves, aPoints) Dim i, tmp, maxNode, aNode1, aNode2, aAdjacency ' reserve enough space for nodes ReDim aAdjacency(2*UBound(aCurves)) For i=0 To UBound(aAdjacency) aAdjacency(i) = Array() Next ' loop through edges : each one has two nodes maxNode = 0 For i=0 To UBound(aCurves) ' get the end points of each curve aNode1 = Rhino.PointArrayClosestPoint(aPoints, Rhino.CurveStartPoint(aCurves(i))) aNode2 = Rhino.PointArrayClosestPoint(aPoints, Rhino.CurveEndPoint(aCurves(i))) ' node1 -> node2 tmp = aAdjacency(aNode1) ReDim Preserve tmp(UBound(tmp)+1) tmp(UBound(tmp)) = aNode2 aAdjacency(aNode1) = tmp ' node2 -> node1 tmp = aAdjacency(aNode2) ReDim Preserve tmp(UBound(tmp)+1) tmp(UBound(tmp)) = aNode1 aAdjacency(aNode2) = tmp ' find the last node If (aNode1 > maxNode) Then maxNode = aNode1 If (aNode2 > maxNode) Then maxNode = aNode2 Next ' shrink list : eliminate empty lines in the adjacency list ReDim Preserve aAdjacency(maxNode) AdjacencyList = aAdjacency End Function

2. Exports a Rhino mesh to GSA

Option Explicit ' Giovani Estrada, 30.04.2012 ' ' It exports a mesh to GSA in GWA format. ' ' Note: ' Please check, and change as appropriate, the default ' units (kN-m) and materials in the subroutine "CreateGWA". ' Dim strElement : strElement = "BEAM" ' default linear element as either BEAM or BAR Call Main Sub Main Dim arrPin, strMesh, objFSO, objStream strMesh = Rhino.GetObject("Select a mesh", 32) If IsNull(strMesh) Then Exit Sub ' get the list of pinned nodes arrPin = getPinNodes(strMesh) ' write a GWA header CreateGWA objFSO, objStream ' write nodes WriteGWAnodes arrPin, strMesh, objStream ' write bar/beams + TRI3/QUAD elements WriteGWAstructure strMesh, objStream End Sub Function getPinNodes(strMesh) Dim arrPin : arrPin = Null Dim arrResults, arrPoints, arrBorder, arrBorders ' default points -- hint the user about contour points arrBorders = Rhino.DuplicateMeshBorder(strMesh) Rhino.SelectObjects arrBorders Rhino.Command "_-PointsOn" ' should we take the contour (default) or pick individually? arrResults = Rhino.GetBoolean("Pin nodes", _ Array("select", "individually", "contour"), Array(True)) ' no more hints Rhino.Command "_-PointsOff" ' pointwise or contour If IsArray(arrResults) Then If arrResults(0) = False Then arrPin = Rhino.GetMeshVertices(strMesh) End If ' nothing selected? --> take contour by default (convert coordinates to mesh vertex index) Rhino.UnselectAllObjects If IsNull(arrPin) Then ' get the identifier of border points For Each arrBorder In arrBorders Rhino.SelectObjects Rhino.AddPoints(Rhino.CurvePoints(arrBorder)) Next ' get the mesh vertex id of each border point arrPoints = Rhino.SelectedObjects arrPin = matchXYZtoMeshID(arrPoints, strMesh) Rhino.DeleteObjects arrPoints ' delete temporary objects End If ' no more hints Rhino.DeleteObjects arrBorders getPinNodes = arrPin End Function ' ' returns the mesh vertex index closer to XYZ ' IN : array of point identifiers -- arrPoints ' IN : mesh ' OUT : array of mesh vertex indices Function matchXYZtoMeshID(arrPoints, strMesh) Dim arrVertices : arrVertices = Rhino.MeshVertices(strMesh) Dim arrResults : arrResults = Null Dim i, arrXYZ ' initialise results & temporary arrays ReDim arrResults(UBound(arrPoints)) ReDim arrXYZ(UBound(arrPoints)) ' get the coordinates of point identifiers For i=0 To UBound(arrPoints) arrXYZ(i) = Rhino.PointCoordinates(arrPoints(i)) Next ' get the closer mesh vertex to given coordinate For i=0 To UBound(arrPoints) arrResults(i) = Rhino.PointArrayClosestPoint(arrVertices, arrXYZ(i)) Next matchXYZtoMeshID = arrResults End Function ' ' membership function (is "element" in "aList"?) ' Function ElementInList(element, aList) Dim i, myFlag : myFlag = 0 For i=0 To UBound(aList) If aList(i)=element Then myFlag=1 Next ElementInList = myFlag End Function ' ' write nodes in GWA format, free nodes, no constraints (pin) ' Sub WriteGWAnodes(aFixed, strMesh, objStream) Dim strPoint, strText, i, x, y, z Dim saveLocale, aPoints ' array of non-repeated vertex coordinates aPoints = Rhino.CullDuplicatePoints(Rhino.MeshVertices(strMesh)) ' got some restraints? If (UBound(aFixed)<1) Then Rhino.Print "Warning : no restrained nodes!" End If ' GSA requires the following numeric format: 123.45 saveLocale = GetLocale() SetLocale("en-us") i = 1 For Each strPoint In aPoints x = strPoint(0) y = strPoint(1) z = strPoint(2) If Abs(x) < 1E-8 Then x = 0 ' too small for GSA If Abs(y) < 1E-8 Then y = 0 ' better to round off If Abs(z) < 1E-8 Then z = 0 ' to zero ' write a free or constrained node (ie member of aFixed) strText = "NODE" & vbTab & i & vbTab & vbTab & "NO_RGB" & vbTab & x & vbTab & y & vbTab & z If ElementInList(i-1, aFixed) Then strText = strText + " NO_GRID 0 REST 1 1 1 0 0 0" End If objStream.WriteLine(strText) i = i + 1 Next ' restore the default format SetLocale(saveLocale) End Sub ' ' Write the header of a GWA file ' It defines steel RFR and other defaults, including a material type ' for beams. ' Sub CreateGWA(objFSO, objStream) Dim strFilter, strFileName ' save a GWA file strFilter = "GWA File (*.gwa)|*.gwa|All Files (*.*)|*.*|" strFileName = Rhino.SaveFileName("Save mesh as", strFilter) If IsNull(strFileName) Then Exit Sub ' Get the file system object ' Dim objFSO, objStream Set objFSO = CreateObject("Scripting.FileSystemObject") ' Open a text file to write to On Error Resume Next Set objStream = objFSO.CreateTextFile(strFileName, True) If Err Then MsgBox Err.Description Exit Sub End If ' avoid problems with DimStyle, write it as string directly, kN/m objStream.WriteLine("TITLE Converted with mesh2gsa " & Rhino.DocumentPath & Rhino.DocumentName & vbTab & CStr(Now)) objStream.WriteLine("UNIT_DATA FORCE kN 0.001") objStream.WriteLine("UNIT_DATA LENGTH m 1") objStream.WriteLine("UNIT_DATA DISP mm 1000") objStream.WriteLine("UNIT_DATA SECTION cm 100") objStream.WriteLine("UNIT_DATA MASS t 0.001") objStream.WriteLine("UNIT_DATA TIME s 1") objStream.WriteLine("UNIT_DATA TEMP °C 1") objStream.WriteLine("UNIT_DATA STRESS N/mm² 1E-6") objStream.WriteLine("UNIT_DATA ACCEL m/s² 1") objStream.WriteLine("UNIT_DATA ENERGY kJ 0.001") objStream.WriteLine("CURRENCY EUR") ' default materials objStream.WriteLine("SPEC_STEEL_DESIGN ") objStream.WriteLine("SPEC_CONC_DESIGN UNDEF UNDEF") objStream.WriteLine("PROP_SEC 1 grillage NO_RGB CONC_SHORT STD%R%200.%200. NO NA 0.000000 NO_PROP NO_MOD_PROP") objStream.WriteLine("PROP_2D 1 shell NO_RGB GLOBAL CONC_LONG SHELL 0.0400000 0.000000 100.000% 100.000%") ' default loads objStream.WriteLine("LOAD_TITLE 1 Dead DEAD BRIDGE_NO") objStream.WriteLine("LOAD_TITLE 2 Live IMPOSED BRIDGE_NO") objStream.WriteLine("LOAD_GRAVITY All 1 0 0 -1") objStream.WriteLine("LOAD_BEAM_UDL PB1 2 GLOBAL YES Z -1") End Sub ' ' keep a list of linear element (either beam or bar) ' Sub AddBeam(iStart, iEnd, aBeamList) Dim beam, myFlag : myFlag = 1 ' is it a valid beam? If (iStart=iEnd) Then Exit Sub ' and not repeated? For Each beam In aBeamList If (beam(0)=iStart And beam(1)=iEnd) Or (beam(0)=iEnd And beam(1)=iStart) Then myFlag=0 Next ' then add it If (myFlag) Then ReDim Preserve aBeamList(UBound(aBeamList)+1) aBeamList(UBound(aBeamList))=Array(iStart, iEnd) End If End Sub ' ' writes beams and panels, the panels are TRI3 or QUAD ' Sub WriteGWAstructure(strObject, objStream) Dim arrFaceVertices, beam, intCount, arrFace, strText, aBeamList() intCount = 1 ' element number ReDim aBeamList(-1) ' initialise list of beams arrFaceVertices = Rhino.MeshFaceVertices(strObject) ' get each panel out of the mesh If IsArray(arrFaceVertices) Then For Each arrFace In arrFaceVertices If arrFace(2)=arrFace(3) Then ' write a triangle strText = "EL" & vbTab & intCount & vbTab & vbTab & "NO_RGB" & vbTab & "TRI3" & vbTab & 1 & vbTab & 1 & vbTab & arrFace(0) + 1 & vbTab & arrFace(1) + 1 & vbTab & arrFace(2) + 1 Else ' write a quad strText = "EL" & vbTab & intCount & vbTab & vbTab & "NO_RGB" & vbTab & "QUAD4" & vbTab & 1 & vbTab & 1 & vbTab & arrFace(0) + 1 & vbTab & arrFace(1) + 1 & vbTab & arrFace(2) + 1 & vbTab & arrFace(3) + 1 End If ' comment out the next two lines if you don't want to save TRI3/QUAD elements objStream.WriteLine(strText) intCount = intCount + 1 ' write the individual faces as beams AddBeam arrFace(0), arrFace(1), aBeamList AddBeam arrFace(1), arrFace(2), aBeamList AddBeam arrFace(2), arrFace(3), aBeamList AddBeam arrFace(3), arrFace(0), aBeamList Next End If ' write beams/bars For Each beam In aBeamList strText = "EL" & vbTab & intCount & vbTab & vbTab & "NO_RGB" & vbTab & strElement & vbTab & 1 & vbTab & 1 & vbTab & _ beam(0)+1 & vbTab & beam(1)+1 objStream.WriteLine(strText) intCount = intCount + 1 Next End Sub