VBA Tip: Create Portable Functions

Published on December 4, 2014
Written by Rod Wing

Once you begin writing VBA tools for one application you will probably expand to writing VBA tools for other applications as well. That’s the beauty of VBA, once you learn the language basics in say MicroStation, you can easily jump to developing applications in Excel, AutoCAD, or other platforms that support VBA. After you’ve been at it awhile you will eventually have the need to develop similar functions for each. You will want to develop these in separate code or class modules using only base VBA data types. These modules can then be easily included into VBA (or even VB.Net) projects on the various platforms.

Here are a group of example functions used to determine if a point lines on a given line. Notice that all of the arguments are Double values, no platform specific point or line data types are used. These can be placed in a separate module and included in any VBA or VB.Net project for any application platform.

Public Const ZERO As Double = 0.00001
Public Const NO_SLOPE As Double = 999999999#
Public Function IsPointOnLine(ByVal pt1X As Double, ByVal pt1Y As Double, _
                                ByVal pt2X As Double, ByVal pt2Y As Double, _
                                ByVal ptTestX As Double, ByVal ptTestY As Double) As Boolean
    Select Case True
        ' test for vertical line
        Case FloatEqual(pt1X, pt2X)
            IsPointOnLine = FloatEqual(pt1X, ptTestX)
        ' test for horizontal line
        Case FloatEqual(pt1Y, pt2Y)
            IsPointOnLine = FloatEqual(pt1Y, ptTestY)
        Case Else
            'slope intercept equation
            'y = mx + b
            '1. determine slope and y intercept of line
            '2. plug in test point
            '3. slope and intercept must be equal to original line
            Dim m As Double
            Dim b As Double
            m = SlopeOfLine2D(pt1X, pt1Y, pt2X, pt2Y)
            b = YIntercept2D(pt1X, pt1Y, m)
            'y = mx + b
            IsPointOnLine = FloatEqual(ptTestY, ((m * ptTestX) + b))
    End Select
End Function
Public Function YIntercept2D(ByVal pt1X As Double, ByVal pt1Y As Double, ByVal dSlope As Double) As Double
    If FloatEqual(dSlope, NO_SLOPE) Then
        YIntercept2D = NO_SLOPE
    Else
        YIntercept2D = (-1 * (dSlope * pt1X)) + pt1Y
    End If
End Function
Public Function SlopeOfLine2D(ByVal pt1X As Double, ByVal pt1Y As Double, _
                              ByVal pt2X As Double, ByVal pt2Y As Double) As Double
    If FloatEqual((pt2X - pt1X), 0) Then
        SlopeOfLine2D = NO_SLOPE
    Else
        SlopeOfLine2D = (pt2Y - pt1Y) / (pt2X - pt1X)
    End If
End Function
Public Function FloatEqual(ByVal inValue1 As Double, ByVal inValue2 As Double, _
                     Optional ByVal fltPrecision As Double = ZERO) As Boolean
      FloatEqual = Abs(inValue2 - inValue1) < fltPrecision
End Function

Once included in your VBA or VB.Net project you have exactly the same functions available. Some examples are shown below.

'Excel VBA
Public Function IsPointOnLine_Excel(cellX1 As String, cellY1 As String, _
                                    cellX2 As String, cellY2 As String, _
                                    cellTestX As String, cellTestY As String) As Boolean
    IsPointOnLine_Excel = IsPointOnLine(Range(cellX1).Value, Range(cellY1).Value, _
                                        Range(cellX2).Value, Range(cellY2).Value, _
                                        Range(cellTestX).Value, Range(cellTestY).Value)
End Function
'MicroStation VBA
Public Function IsPointOnLine_MicroStation(elLine As LineElement, ptTest As Point3d) As Boolean
    IsPointOnLine_MicroStation = IsPointOnLine(elLine.startPoint.X, elLine.startPoint.Y, _
                                               elLine.EndPoint.X, elLine.EndPoint.Y, _
                                               ptTest.X, ptTest.Y)
End Function
Public Function IsPointOnLine2_MicroStation(ptStart As Point3d, ptEnd As Point3d, ptTest As Point3d) As Boolean
    IsPointOnLine2_MicroStation = IsPointOnLine(ptStart.X, ptStart.Y, _
                                                ptEnd.X, ptEnd.Y, _
                                                ptTest.X, ptTest.Y)
End Function
'AutoCAD VB.NET
Public Overloads Function IsPointOnLine_ACAD(ByVal entLine As Autodesk.AutoCAD.DatabaseServices.Line, _
                                   ByVal ptTest As Autodesk.AutoCAD.Geometry.Point3d) As Boolean
    IsPointOnLine_ACAD = IsPointOnLine(entLine.startPoint.X, entLine.startPoint.Y, _
                                       entLine.EndPoint.X, entLine.EndPoint.Y, _
                                       ptTest.X, ptTest.Y)
End Function
Public Overloads Function IsPointOnLine_ACAD(ByVal ptStart As Autodesk.AutoCAD.Geometry.Point3d, _
                                   ByVay ptEnd As Autodesk.AutoCAD.Geometry.Point3d, _
                                   ByVal ptTest As Autodesk.AutoCAD.Geometry.Point3d) As Boolean
    IsPointOnLine_ACAD = IsPointOnLine(ptStart.X, ptStart.Y, _
                                       ptEnd.X, ptEnd.Y, _
                                       ptTest.X, ptTest.Y)
End Function

Last month’s tips:

mapimport                dialog to import linestyle library                 Roadway Designer Place Temporary Dimension2
Civil 3D Tip: Converting Civil 3D     MicroStation Tip: Import           InRoads Tip:  Place Dimensions 
Alignments to ArcGIS Shapefiles     LineStyles into a DGN Library            in Roadway Designer

 

Don’t want to miss out on other great information? Subscribe to this blog or our monthly eNewsletter now!
Learn More ◊ Contact us today ◊ Newsletter ◊
EnvisionCAD Group EnvisionCAD YouTube Channel   
 

Tags:
Like this article? Share it!

Leave a Comment

XHTML: You can use these tags: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Privacy Policy