Hi,
I am trying to use AddSrfSectionCrvs by calling it thru Excel VBA. Below are two identical codes for making a section from a cube (One within RhinoScript and another accessing RhinoScript thru Excel VBA).
When running the script within RhinoScript I can get section of the cube without a problem. But when running it thru Excel VBA everything works besides the last command, i.e. AddSrfSectionCrvs.
I’ve run the code in debug mode, both in RhinoScript and Excel VBA. In the former I get the curve and the string for the newly created section curve, but in Excel VBA no string and no curve is returned.
Picture 1. Sections made x=450 and x=400
Calling AddSrfSectionCrvs within RhinoScript:
Const rhObjectSurface = 8
Const rhObjectPolysurface = 16
Dim strObject, arrPlane
strObject = Rhino.GetObject("Select object", rhObjectSurface + rhObjectPolysurface)
arrCPlane = Rhino.ViewCPlane
Dim arrOrigin
Dim arrNormal
Dim strCurves
arrOrigin = array(300, 0, 0)
arrNormal = array(1, 0, 0)
arrPlane = Rhino.PlaneFromNormal(arrOrigin, arrNormal)
strCurves = Rhino.AddSrfSectionCrvs(strObject, arrPlane)
Calling AddSrfSectionCrvs within Excel VBA:
**************************************
* Initializing connection with Rhino *
**************************************
Dim version As Integer
version = Range("C4")
' Create Interface object. Connect to an allready running instance of Rhino 5.
Dim RhinoApp As Object
Select Case version
Case 1
On Error Resume Next
Set RhinoApp = CreateObject("Rhino5.Interface")
If (Err.Number <> 0) Then
MsgBox ("Failed to create Rhino5 x86 object")
Exit Sub
End If
Case 2
On Error Resume Next
Set RhinoApp = CreateObject("Rhino5x64.Interface")
If (Err.Number <> 0) Then
MsgBox ("Failed to create Rhino5 x64 object")
Exit Sub
End If
End Select
' Make attempts to get RhinoScript, sleep between each attempt.
Dim RhinoScript As Object
Dim nCount As Integer
nCount = 0
Do While (nCount < 10)
On Error Resume Next
Set RhinoScript = RhinoApp.GetScriptObject()
If Err.Number <> 0 Then
Err.Clear
Sleep 500 'waits for 500 ms
nCount = nCount + 1
Else
Exit Do
End If
Loop
' Display an error if needed.
If (RhinoScript Is Nothing) Then
MsgBox ("Failed to get RhinoScript")
End If
*********************************************************************
* Same part of code as in RhinoScript for calling AddSrfSectionCrvs *
*********************************************************************
Const rhObjectSurface = 8
Const rhObjectPolysurface = 16
Dim strObject As String
Dim arrPlane()
strObject = RhinoScript.GetObject("Select object", rhObjectSurface + rhObjectPolysurface
Dim arrOrigin()
Dim arrNormal()
Dim strCurve As String
arrOrigin = Array(200, 0, 0)
arrNormal = Array(1, 0, 0)
arrPlane = RhinoScript.PlaneFromNormal(arrOrigin, arrNormal)
strCurve = RhinoScript.AddSrfSectionCrvs(strObject, arrPlane)
Thanks,
Andres
2 posts - 1 participant
Read full topic
