@@ -12,7 +12,7 @@ Option Explicit
1212Option Base 0
1313'#
1414'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
15- ' Copyright © 2022-2024 W. García
15+ ' Copyright © 2022-2025 W. García
1616' GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
1717' https://ingwilfredogarcia.wordpress.com
1818'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -312,7 +312,7 @@ Private Sub Class_Initialize()
312312 P_SEPARATORCHAR = d_Semicolon
313313 P_DEC_SYMBOL = dsDot
314314 AscDecSymbol = 46
315- P_GALLOPING_MODE = True
315+ P_GALLOPING_MODE = False
316316 P_FORMATRESULT = False
317317 BuildinFunctIDList = "abs;floor;achisq;asin;acos;aerf;afishf;agauss;asc;anorm;atn;astudt;array;avg;beta.dist" & _
318318 ";betainv;ceil;chisq;cholesky;cholinverse;cholsolve;chr;cos;choose;date;dateadd;datediff" & _
@@ -2888,10 +2888,10 @@ err_Handler:
28882888End Function
28892889
28902890''' <summary>
2891- ''' Returns the distance between two given points. The points
2892- ''' must be given each one in array format, ex.:
2893- ''' {{x1;y1}};{{x2;y2}}
2891+ ''' Returns the distance between two given points.
28942892''' </summary>
2893+ ''' <param name="Point1">Array of coordinates in format {{x1;y1}}.</param>
2894+ ''' <param name="Point2">Array of coordinates in format {{x2;y2}}.</param>
28952895Private Function Distance (ByRef expression As String , ByRef fName As String ) As String
28962896 Dim argsCount As Long
28972897 Dim tmpData() As String
@@ -3105,7 +3105,9 @@ Private Function EvalFunction(ByRef Argument As String, ByRef FunctionName As St
31053105 Case "aNow" : EvalFunction = Now_(Argument, FunctionName)
31063106 Case "aNPER" : EvalFunction = NPER_(Argument, FunctionName)
31073107 Case "aNPV" : EvalFunction = NPV_(Argument, FunctionName)
3108+ Case "ParallelLine" : EvalFunction = ParallelLine(Argument, FunctionName)
31083109 Case "Percent" : EvalFunction = Percent(Argument, FunctionName)
3110+ Case "PerpendicularLine" : EvalFunction = PerpendicularLine(Argument, FunctionName)
31093111 Case "aPMT" : EvalFunction = PMT_(Argument, FunctionName)
31103112 Case "aPPMT" : EvalFunction = PPMT_(Argument, FunctionName)
31113113 Case "Power" : EvalFunction = Power(Argument, FunctionName)
@@ -3670,7 +3672,6 @@ Private Function fZeroMBM(ByRef aFunction As String, ByVal A As Double, _
36703672 aZero = 10 * epsilon
36713673 With fEvalHelper
36723674 .Create aFunction
3673- .GallopingMode = False
36743675 tmpVar() = Split(.CurrentVariables, "; " )
36753676 varLB = LBound(tmpVar)
36763677 If UBound(tmpVar) - varLB > 0 Then 'Reject multivariate functions
@@ -3787,7 +3788,6 @@ Private Function fZeroMRF(ByRef aFunction As String, ByVal A As Double, _
37873788 Set fEvalHelper = New VBAexpressions
37883789 aZero = 10 * epsilon
37893790 With fEvalHelper
3790- .GallopingMode = False
37913791 .Create aFunction
37923792 tmpVar() = Split(.CurrentVariables, "; " )
37933793 varLB = LBound(tmpVar)
@@ -5883,10 +5883,9 @@ End Function
58835883
58845884''' <summary>
58855885''' Returns the intersection point for two lines.
5886- ''' The lines must be given by two crossing points each
5887- ''' in array format, ex.:
5888- ''' {{x1;y1};{x2;y2}}; {{x3;y3};{x4;y4}}
58895886''' </summary>
5887+ ''' <param name="Line1">Array of coordinates in format {{x1;y1};{x2;y2}}.</param>
5888+ ''' <param name="Line2">Array of coordinates in format {{x3;y3};{x4;y4}}.</param>
58905889Private Function LinesIntersect (ByRef expression As String , ByRef fName As String ) As String
58915890 Dim argsCount As Long
58925891 Dim tmpData() As String
@@ -5906,14 +5905,16 @@ Private Function LinesIntersect(ByRef expression As String, ByRef fName As Strin
59065905 aArray(0 ) = ToDblArray(ArrayFromString(tmpData(LB)))
59075906 aArray(1 ) = ToDblArray(ArrayFromString(tmpData(UB)))
59085907 tmpEval = LinesIntersection(aArray(0 ), aArray(1 ))
5909- If IsArray(tmpEval) Then
5910- tmpEval = ArrayToString(tmpEval)
5911- End If
59125908 Case Else
59135909 tmpEval = e_ValueError
59145910 BuildErrMessage errMissingArgsOrTooManyArgs, d_lCurly & fName & d_rCurly
59155911 End Select
5916- LinesIntersect = tmpEval: Erase tmpData
5912+ If IsArray(tmpEval) Then
5913+ LinesIntersect = ArrayToString(tmpEval)
5914+ Else
5915+ LinesIntersect = tmpEval
5916+ End If
5917+ Erase tmpData
59175918 Exit Function
59185919err_Handler:
59195920 LinesIntersect = e_ValueError
@@ -7547,6 +7548,66 @@ Private Function PatternToCheckOn(ByRef ArgDefStr As String) As String
75477548 End If
75487549End Function
75497550
7551+ ''' <summary>
7552+ ''' Returns two points representing a line parallel to the given one and
7553+ ''' containing the given point.
7554+ ''' </summary>
7555+ ''' <param name="Line">Array of coordinates in format {{x1;y1};{x2;y2}}.</param>
7556+ ''' <param name="Point">Array of coordinates in format {{x;y}}.</param>
7557+ Private Function ParallelLine (ByRef expression As String , ByRef fName As String ) As String
7558+ Dim argsCount As Long
7559+ Dim tmpData() As String
7560+ Dim tmpEval As String
7561+ Dim LB As Long , UB As Long
7562+
7563+ On Error GoTo err_Handler
7564+ tmpData() = SplitArgs(expression)
7565+ LB = LBound(tmpData)
7566+ UB = UBound(tmpData)
7567+ argsCount = UB - LB + 1
7568+ Select Case argsCount
7569+ Case 2
7570+ Dim aArray() As Variant
7571+ Dim aTerm As Double
7572+ Dim bTerm As Double
7573+ Dim cTerm As Double
7574+ Dim pointArr(0 To 1 ) As Variant
7575+ Dim tmpArr(0 To 1 ) As Double
7576+ ReDim aArray(0 To 1 )
7577+
7578+ aArray(0 ) = ToDblArray(ArrayFromString(tmpData(LB)))
7579+ aArray(1 ) = ToDblArray(ArrayFromString(tmpData(UB)))
7580+ aTerm = aArray(0 )(0 , 1 ) - aArray(0 )(1 , 1 ) 'y1-y2
7581+ bTerm = aArray(0 )(1 , 0 ) - aArray(0 )(0 , 0 ) 'x2-x1
7582+ cTerm = aArray(0 )(0 , 0 ) * aArray(0 )(1 , 1 ) _
7583+ - aArray(0 )(1 , 0 ) * aArray(0 )(0 , 1 ) 'x1*y2-x2*y1
7584+ pointArr(0 ) = aArray(1 )
7585+ If aTerm <> 0 And bTerm <> 0 Then
7586+ tmpArr(0 ) = 0
7587+ tmpArr(1 ) = (aTerm * aArray(1 )(0 ) + bTerm * aArray(1 )(1 )) / bTerm
7588+ Else
7589+ If aTerm = 0 Then 'Horizontal line
7590+ tmpArr(0 ) = aArray(1 )(0 ) - aArray(1 )(1 ) + 1
7591+ tmpArr(1 ) = aArray(1 )(1 )
7592+ Else 'Vertical line
7593+ tmpArr(0 ) = aArray(1 )(0 )
7594+ tmpArr(1 ) = aArray(1 )(0 ) - aArray(1 )(1 ) + 1
7595+ End If
7596+ End If
7597+ pointArr(1 ) = tmpArr
7598+ tmpEval = ArrayToString(pointArr)
7599+ Case Else
7600+ tmpEval = e_ValueError
7601+ BuildErrMessage errMissingArgsOrTooManyArgs, d_lCurly & fName & d_rCurly
7602+ End Select
7603+ ParallelLine = tmpEval: Erase tmpData
7604+ Exit Function
7605+ err_Handler:
7606+ ParallelLine = e_ValueError
7607+ BuildErrMessage errEvalError, d_lCurly & fName & d_rCurly & " | Error#: " & err.Number & d_Space & _
7608+ d_lParenthesis & err.Description & d_rParenthesis
7609+ End Function
7610+
75507611Private Function Percent (ByRef expression As String , ByRef fName As String ) As String
75517612 On Error GoTo err_Handler
75527613 Percent = CDbl(expression) / 100
@@ -7557,6 +7618,77 @@ err_Handler:
75577618 d_lParenthesis & err.Description & d_rParenthesis
75587619End Function
75597620
7621+ ''' <summary>
7622+ ''' Returns two points representing a line perpendicular to the
7623+ ''' given one and containing the given point.
7624+ ''' </summary>
7625+ ''' <param name="Line">Array of coordinates in format {{x1;y1};{x2;y2}}.</param>
7626+ ''' <param name="Point">Array of coordinates in format {{x;y}}.</param>
7627+ Private Function PerpendicularLine (ByRef expression As String , ByRef fName As String ) As String
7628+ Dim argsCount As Long
7629+ Dim tmpData() As String
7630+ Dim tmpEval As String
7631+ Dim LB As Long , UB As Long
7632+
7633+ On Error GoTo err_Handler
7634+ tmpData() = SplitArgs(expression)
7635+ LB = LBound(tmpData)
7636+ UB = UBound(tmpData)
7637+ argsCount = UB - LB + 1
7638+ Select Case argsCount
7639+ Case 2
7640+ Dim aArray() As Variant
7641+ Dim aTerm As Double
7642+ Dim bTerm As Double
7643+ Dim cTerm As Double
7644+ Dim pointArr(0 To 1 ) As Variant
7645+ Dim tmpArr(0 To 1 ) As Double
7646+ ReDim aArray(0 To 1 )
7647+
7648+ aArray(0 ) = ToDblArray(ArrayFromString(tmpData(LB)))
7649+ aArray(1 ) = ToDblArray(ArrayFromString(tmpData(UB)))
7650+ aTerm = aArray(0 )(0 , 1 ) - aArray(0 )(1 , 1 ) 'y1-y2
7651+ bTerm = aArray(0 )(1 , 0 ) - aArray(0 )(0 , 0 ) 'x2-x1
7652+ cTerm = aArray(0 )(0 , 0 ) * aArray(0 )(1 , 1 ) _
7653+ - aArray(0 )(1 , 0 ) * aArray(0 )(0 , 1 ) 'x1*y2-x2*y1
7654+ pointArr(0 ) = aArray(1 )
7655+ If aTerm <> 0 And bTerm <> 0 Then
7656+ ' (-c*a+b(b*x3-a*y3))/(a^2 + b^2)
7657+ tmpArr(0 ) = (-cTerm * aTerm + bTerm * (bTerm * aArray(1 )(0 ) - aTerm * aArray(1 )(1 ))) _
7658+ / _
7659+ (aTerm ^ 2 + bTerm ^ 2 )
7660+ ' (-a(b*x3-a*y3)-b*c)/(a^2 + b^2)
7661+ tmpArr(1 ) = (-aTerm * (bTerm * aArray(1 )(0 ) - aTerm * aArray(1 )(1 )) - bTerm * cTerm) _
7662+ / _
7663+ (aTerm ^ 2 + bTerm ^ 2 )
7664+ If pointArr(0 )(0 ) = tmpArr(0 ) And _
7665+ pointArr(0 )(1 ) = tmpArr(1 ) Then 'Known point is the intersection
7666+ tmpArr(0 ) = pointArr(0 )(0 ) + 1
7667+ tmpArr(1 ) = pointArr(0 )(1 ) + bTerm / aTerm
7668+ End If
7669+ Else
7670+ If aTerm = 0 Then 'Horizontal line
7671+ tmpArr(0 ) = aArray(1 )(0 )
7672+ tmpArr(1 ) = aArray(1 )(0 ) - aArray(1 )(1 ) + 1
7673+ Else 'Vertical line
7674+ tmpArr(0 ) = aArray(1 )(0 ) - aArray(1 )(1 ) + 1
7675+ tmpArr(1 ) = aArray(1 )(1 )
7676+ End If
7677+ End If
7678+ pointArr(1 ) = tmpArr
7679+ tmpEval = ArrayToString(pointArr)
7680+ Case Else
7681+ tmpEval = e_ValueError
7682+ BuildErrMessage errMissingArgsOrTooManyArgs, d_lCurly & fName & d_rCurly
7683+ End Select
7684+ PerpendicularLine = tmpEval: Erase tmpData
7685+ Exit Function
7686+ err_Handler:
7687+ PerpendicularLine = e_ValueError
7688+ BuildErrMessage errEvalError, d_lCurly & fName & d_rCurly & " | Error#: " & err.Number & d_Space & _
7689+ d_lParenthesis & err.Description & d_rParenthesis
7690+ End Function
7691+
75607692Private Function PMT_ (ByRef expression As String , ByRef fName As String ) As String
75617693 Dim argsCount As Long
75627694 Dim tmpData() As String
0 commit comments