A Replacement for VB Evaluate(string)

To graph a function we need to evaluate a string into its math equivalent. Excel VBA has the Application.Evaluate method which takes a variant for an argument and will evaluate a wide range of math symbols, with or without quotations – whatever is between the parentheses. In Visual Studio that doesn’t exist. We want to type a function (the right side of Y = some expression of X) into a textbox on a form, save it to a string variable, then calculate the value to a double for a range of X values. For instance,

strfunc = “X^3 – 3*X^2 + 2*x + 2”

A loop calculates X and Y values starting at X minimum, incrementing by a small X increment, ending at X maximum, and saving all the values to an array to be an argument for AddLightWeightPolyline.

the number of points to be stitched into a graph is calculated –
numpts = CInt((Xmax – Xmin) / Xinc) ‘number of line segments

there is always one more point than line segments
numpts = numpts + 1

the array of doubles is sized –
ReDim Pt(0 To numpts * 2 – 1) ‘store x and y for one pt

after the number of points has been calculated, and the array is ready, the loop is

For i = 1 To numpts
x = Xmin + ((i - 1) * Xinc)
y = eval_func(strfunc, x)
pt(i * 2 - 2) = x
pt(i * 2 - 1) = y
Next i

X is recalulated each time through the loop. Rather than adding the increment to a running sum, its more accurate to use the loop counter to multiply the increment, because of the imprecision of doubles. With odd numbers you might eventually run one cycle short or long. The loop counter should always be an integer. Calculation of Y is handed off to a function with the function string and the current value of X. The function substitutes the numerical value of X whereever X the symbol appears.

Debug.Print strfunc
strfunc = Replace(strfunc, “x”, x, , , vbTextCompare)
Debug.Print strfunc

the first time thru where X is at the starting value of, say, -6, the string and the modified string look like –

X^3 – 3*X^2 + 2*x + 2
-6^3 – 3*-6^2 + 2*-6 + 2

then the final scalar value is calculated and the value returned as Y.

dbl_result = Evaluate(strfunc)

This code was being run from Excel. Evaluate was a method of the top level Application.

For Visual Studio VB.Net we need a replacement for Evaluate.

A lot of people have asked this question. There are quite a few homebuilt parser class solutions. Another method is to link to another language and use its Eval method. A quick easy solution was found, credit to user kleinma

https://www.vbforums.com/showthread.php?412232-RESOLVED-02-03-Question-about-using-VBScript-(Eval)-in-VB-NET

As kleinma says, “Set a reference in your app to “Microsoft Script Control 1.0″ It is under the COM tab in references, not in the .NET tab”

A lot of testing will show if its a decent fix or just the first try.

    Public Xmin As Double
    Public Xmax As Double
    Public Xinc As Double
    Public Ylim As Double
    Public g_stop As Boolean
    Public g_err_counter As Integer


    Function calc_xy(strfunc As String) As Double()
        'returns an array of x and y doubles
        'Xmax, Xmin, Xinc, Ylim are all assumed to have values
        Dim x, y As Double
        Dim i, numpts As Integer
        Dim Pt() As Double

        g_err_counter = 0
        g_stop = False

        numpts = CInt((Xmax - Xmin) / Xinc) 'number of line segments 
        numpts = numpts + 1   'one more pt than line segment
        ReDim Pt(0 To numpts * 2 - 1) 'store x and y for one pt

        For i = 1 To numpts
            x = Xmin + ((i - 1) * Xinc)
            y = eval_func(strfunc, x)

            If g_stop Then  'if eval_func set g_stop then
                MsgBox("errorcounter at 3 - exiting")
                Exit For
            End If
            Pt(i * 2 - 2) = x
            Pt(i * 2 - 1) = y
        Next i

        Return Pt
    End Function

    Function eval_func(ByVal strfunc As String, x As Double) As Double
        'returns a double
        'on error returns Ylim but sets a flag to stop after 3 errors
        'which would indicate a bad formula
        'one or two error is ok because havent solved the mid-graph asymptote yet
        Dim result As Double
        strfunc = Replace(strfunc, "x", x.ToString, , , vbTextCompare)

        Dim SC As New MSScriptControl.ScriptControl
        SC.Language = "VBSCRIPT"
        Try
            result = Convert.ToDouble(SC.Eval(strfunc))
        Catch ex As Exception         
            MessageBox.Show(ex.GetType.ToString & " " & ex.Message)
            g_err_counter = g_err_counter + 1
            If g_err_counter > 2 Then
                g_stop = True
            End If
            result = Ylim
        End Try

        Return result
    End Function

Cartesian form

Capture_11-17-2015-2


Option Explicit

Sub init_rect()
Call connect_acad
Xmin = frm_rect.txt_xmin
Xmax = frm_rect.txt_xmax
X_inc = frm_rect.txt_xinc
A = 0
B = 0
C = 0
D = 0
E = 0
F = 0
End Sub

Sub draw_rect(funcname As String)
'Call connect_acad
Dim X As Double, Y As Double
Dim plineobj As AcadLWPolyline
Dim pt() As Double
Dim i As Integer, numpts As Integer

numpts = (Xmax - Xmin) / X_inc 'number of line segments
numpts = numpts + 1 'one more pt than line segment
ReDim pt(1 To numpts * 2) 'store x and y for one pt

For i = 1 To numpts
X = Xmin + ((i - 1) * X_inc)
Y = Application.Run(funcname, X)
pt(i * 2 - 1) = X: pt(i * 2) = Y
Next i

Set plineobj = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
Update

If frm_rect.chk_box_label_graph = True Then
label_graph
End If

End Sub

Function C_02(X As Double) As Double
'Y = AX ^ 2 + BX + C
C_02 = A * (X ^ 2) + B * X + C
End Function

Function C_03(X As Double) As Double
'Y = A * (X ^ 3) + B * (X ^ 2) + C * X + D
C_03 = A * (X ^ 3) + B * (X ^ 2) + C * X + D
End Function

Function C_04(X As Double) As Double
'Y = A * (X ^ 4) + B * (X ^ 3) + C * (X ^ 2) + D * X + E
C_04 = A * (X ^ 4) + B * (X ^ 3) + C * (X ^ 2) + D * X + E
End Function

Function C_06(X As Double) As Double
'Y = A * (B ^ X) / A * (B ^ X)
C_06 = (A * (X ^ 2) + B * X + C) / (D * (X ^ 2) + E * X + F)
End Function

Function C_07(X As Double) As Double
'Y = A * (B ^ X)
C_07 = A * (B ^ X)
End Function

Sub draw_c02()
Call init_rect
funcname = "C_02"
On Error Resume Next
A = frm_rect.txt_a2.Value
B = frm_rect.txt_b2.Value
C = frm_rect.txt_c2.Value
strLabel = "Y= " & A & "X^2 + " & B & "X + " & C
Call draw_rect(funcname)
End Sub

Sub draw_c03()
Call init_rect
funcname = "C_03"
On Error Resume Next
A = frm_rect.txt_a3.Value
B = frm_rect.txt_b3.Value
C = frm_rect.txt_c3.Value
D = frm_rect.txt_d3.Value
strLabel = "Y= " & A & "X^3 + " & B & "X^2 + " & C & "X + " & D
Call draw_rect(funcname)
End Sub

Sub draw_c04()
Call init_rect
funcname = "C_04"
On Error Resume Next
A = frm_rect.txt_a4.Value
B = frm_rect.txt_b4.Value
C = frm_rect.txt_c4.Value
D = frm_rect.txt_d4.Value
E = frm_rect.txt_e4.Value
strLabel = "Y= " & A & "X^4 + " & B & "X^3 + " & C & "X^2 + " & D & "X +" & E
Call draw_rect(funcname)
End Sub

Sub draw_c06()
Call init_rect
funcname = "C_06"
On Error Resume Next
A = frm_rect.txt_a6.Value
B = frm_rect.txt_b6.Value
C = frm_rect.txt_c6.Value
D = frm_rect.txt_d6.Value
E = frm_rect.txt_e6.Value
F = frm_rect.txt_f6.Value

strLabel = "Y= " & A & "X^2 + " & B & "X + " & C
strLabel = strLabel & " / " & D & "X^2 + " & E & "X + " & F
Call draw_rect(funcname)
End Sub

Sub draw_c07()
Call init_rect
funcname = "C_07"
On Error Resume Next
A = frm_rect.txt_a7.Value
B = frm_rect.txt_b7.Value
strLabel = "Y= " & A & "*" & B & "^X"
Call draw_rect(funcname)
End Sub

Functions

Capture_11-09-2015-1
f stands for function in the generalized notation y=f(x). The function is an equation that for any x or for any x in a specific interval returns a value for y. In the same way a vba function is a formulation that returns a value to be captured in a variable.

We have a good loop template to process equations, but whenever a new equation is to be used, the entire sub procedure is copied to a new name and just one line of code with the equation is changed. The goal is to reduce the duplicated code. If we write the equation into a function to return a value, we still need unique sub procedures to call the correct function, but putting the equations into functions to return a value then calling the function in the loop seems like a road that will go somewhere.

We will make the function name look like the equation it contains for now, but this will be too cumbersome to maintain. We will make an index using a spreadsheet to keep track of function names and their equations.

for our two rose petal equations
R = B * Sin (C*A) + D
R = B * Cos (C*A) + D

Function B_Sin_C_A_D(A_rad As Double) As Double
'R = B * Sin(C * A) + D
B_Sin_C_A_D = B * Sin(C * A_rad) + D
End Function

Function B_Cos_C_A_D(A_rad As Double) As Double
'R = B * Cos(C * A) + D
B_Cos_C_A_D = B * Cos(C * A_rad) + D
End Function

If we cannot call either of these functions from a single subprocedure, we have not reduced anything. We need a method to call a function by passing its name.

Application.Run

in the loop where we used to have
‘R = B * Sin(C * A_rad) + D
The only value on the right side of the equation that is changing each time through the loop is A_rad. To simplify things we make the other variables global so we do not have to pass them. A_rad is the radian conversion of A degrees, which is our changing interval variable since we are doing a polar equation. It corresponds to x in a rectangular equation.

we can now have
R = Application.Run(funcname, A_rad)

Sub petal(funcname As String)
Call connect_acad

Dim R As Double, A As Integer
Dim X As Double, Y As Double
Dim A_rad As Double
Dim i As Integer, numpts As Integer
Dim plineobj As AcadLWPolyline
Dim pt() As Double

numpts = (Amax - Amin) / A_inc 'num of lines
numpts = numpts + 1
ReDim pt(1 To numpts * 2)

For i = 1 To numpts
A = Amin + ((i - 1) * A_inc)
A_rad = deg2rad(A)

R = Application.Run(funcname, A_rad)

X = R * Cos(A_rad)
Y = R * Sin(A_rad)
pt(i * 2 - 1) = X: pt(i * 2) = Y
Next i

Set plineobj = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
Update
End Sub

The upper level calling program can now look like a recipe. This will change when we integrate this into a form. The variables that go into an actual graph are all made globals – Amin, Amax, A_inc, B, C, D, and funcname.

Sub call_petal()
'R = B * Sin(C * A) + D
funcname = "B_Sin_C_A_D"
Amin = 0
Amax = 360
A_inc = 1
B = 3
C = 5
D = 2

Call petal(funcname)
End Sub

This makes the whole structure more complicated, and detracts from the core graphing code, but something along this line seems necessary to reduce the multiplication of subprocedures which only differ by the function being graphed.

Capture_11-08-2015

First Daisy

Capture_11-05-2015

Spirals are drawn as either individual lines or a connected polyline. A polyline in autocad vba requires an array of points in the form (x1,y1,x2,y2,x3…). This is constructed with a loop that runs once for each point and adds an x and y value to an array each time through the loop. The polyline is drawn outside the loop with a single statement.

The spiral consisting of individual lines is drawn with a loop that runs once for each line. It stores values for two points x1,y1 and x2,y2 each time through the loop. It draws one line segment inside the loop each time through.

The fermat spiral is sometimes used to draw plant simulations using a bit of geometry at each node rather than a straight line. Instead of calling the line subroutine, any other geometry can be called inside the loop. These are sometimes called daisies or sunflowers.


Sub fermat_spiral_daisy1()
'R = B A^1/2
Call init_polar
Dim B As Double, C As Double
Dim i As Integer
Dim numlines As Integer
Dim R1 As Double, R2 As Double
Dim A1 As Integer, A2 As Integer
Dim A1_rad As Double, A2_rad As Double
Dim X1 As Double, X2 As Double
Dim Y1 As Double, Y2 As Double

B = frm_polar.txt_b8.Value
C = 0.5

numlines = (Amax - Amin) / A_inc 'num of lines

For i = 1 To numlines
A1 = Amin + ((i - 1) * A_inc)
A2 = Amin + (i * A_inc)

A1_rad = deg2rad(A1)
A2_rad = deg2rad(A2)

'this is the function
R1 = B * (A1_rad ^ C)
R2 = B * (A2_rad ^ C)

X1 = R1 * Cos(A1_rad)
Y1 = R1 * Sin(A1_rad)
X2 = R2 * Cos(A2_rad)
Y2 = R2 * Sin(A2_rad)

'this would be the regular spiral
'Call line(X1, Y1, X2, Y2)

 Call polygon3(R2, A2)

Next i

Update
End Sub


Sub polygon3(R As Double, A As Integer)
Call connect_acad

Dim X As Double, Y As Double
Dim plineobj As AcadLWPolyline
Dim pt() As Double
Dim t As Integer, numpts As Integer

numpts = 7
ReDim pt(1 To numpts * 2) 'to store both x and y for one pt

Dim AA As Double
Dim RR As Integer
RR = 3

For t = 1 To 7
AA = 2 * pi * t / 6 + deg2rad(A)

X = RR * Cos(AA) + R * Cos(A)
Y = RR * Sin(AA) + R * Sin(A)
pt(t * 2 - 1) = X: pt(t * 2) = Y
Next t

Set plineobj = acadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(pt)
plineobj.Closed = True
Update
End Sub