AddSrfSectionCrvs works within RhinoScript, but not within Excel VBA

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

Cube712×438 6.41 KB

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