PC World Komputer 1998 November/pcwk_11_98a.iso/Wtestowe/SOFTSRC/vtrial15.exe/DATA.1/GLOBALS.BAS

BASIC Source File | 1996-09-15 | 46KB | 1,461 lines

Attribute VB_Name = "Globals"
Option Explicit

'
'
Public ERROR_COUNT As Integer       ' used for tracking number of failures detected during a test

'
'   global object variables for Vdraft objects
Public Vdraft As Object
Public Docs As Object
Public Doc As Object
Public Entities As Object
Public Units As Object
Public Commands As Object
Public EntitySnap As Object
Public Layers As Object
Public LineTypes As Object
Public Colors As Object
Public TextStyles As Object

'
'   entity types
Public Const gblNumEntities = 19
Public gblEntities(gblNumEntities)
Public Const entArc = 0
Public Const entAttdef = 1
Public Const entBlockInsert = 2
Public Const entCircle = 3
Public Const entDimHor = 4
Public Const entDimRad = 5
Public Const entDimVer = 6
Public Const entFace = 7
Public Const entLine = 8
Public Const entPoint = 9
Public Const entPolyline = 10
Public Const entShape = 11
Public Const entSolid = 12
Public Const entStartCenterAngle = 13
Public Const entStartInsert = 14
Public Const entStartLine = 15
Public Const entText = 16
Public Const entThreePtArc = 17
Public Const entTrace = 18
Public Const entViewport = 19


'
'   miscellaneous
Public gblPView As Integer  ' path for launching pview.exe
Public ecoWhich As Integer  ' for entity creation options form
Public CRLF As String
Public IsGlobalUpdating     ' shows that the UpdateGlboalObjs routine is running
Public RandomClick%

Sub DrawArc(X#, Y#, R#, S#, E#, Lyr$, Clr%, Regen%)
'
'   creates and verifies an arc
'

'
'   X#, Y#  are the center point
'   R#      is the radius
'   S#      is the start angle  (in radians)
'   E#      is the end angle    (in radians)
'   L$      is the layer
'   C%      is the color
'   Reg%    is whether to regen when done or not
'
    If (Not Entities Is Nothing) Then
        Dim iArc As Object                      ' the arc itself
        Dim iCenter As Object                   ' the various properties of the arc

        Set iArc = Entities.AddArc              ' create the arc

        If (Not iArc Is Nothing) Then           ' if the arc created successfully....
            Set iCenter = iArc.Center           ' set the center point of the arc
            iCenter.X = X
            iCenter.Y = Y
            iArc.Center iCenter
            Set iCenter = Nothing

            iArc.Radius = R                     ' the radius of the arc
            iArc.StartAngle = S                 ' start angle
            iArc.EndAngle = E                   ' ending angle of the arc

            If (Len(Lyr$) > 0) Then
                iArc.Layer Layers.Item(Lyr$)    ' switch arc to the given layer
            End If

            If (Clr% > -1) Then                 ' switch arc to the given color
                Dim iColor As Object
                Set iColor = Colors.Item(Clr%)
                iArc.Color iColor
                Set iColor = Nothing
            End If

            If Regen% <> 0 Then                 ' regen the new arc if supposed to
                iArc.Regen
            End If

        '
        '   verify all the parameters of the arc
            VerifyArc iArc, X#, Y#, R#, S#, E#, Lyr$, Clr%

            Set iArc = Nothing
        Else
            Debug.Print "Arc creation failed !!!!"
        End If
    Else
        Debug.Print "Can't create arc.  Entities object is not valid"
    End If
End Sub
Sub DrawCircle(X#, Y#, R#, Lyr$, Clr%, Regen%)
'
'   draws a circle with the given parameters
'   to indicated layer (Lyr$), Color (Clr%)
'
'   If Lyr$ is an empty string, then the active layer is used
'   if Clr% = -1, then the color is ByLayer
'
    If ((Not Layers Is Nothing) And (Not Entities Is Nothing)) Then
        Dim Circ As Object, Pt As Object            ' Circ and its points

        Set Circ = Entities.AddCircle()             ' create the new Circle

        Set Pt = Circ.Center                        ' start point of Circle
        Pt.X = X#
        Pt.Y = Y#
        Circ.Center Pt                              ' set the new value back into the circle
        Set Pt = Nothing

        Circ.Radius = R                             ' radius

        If (Len(Lyr$) > 0) Then
            Circ.Layer Layers.Item(Lyr$)            ' switch Circle to the given layer
        End If

        If (Clr% > -1) Then                         ' switch Circle to the given color
            Dim iColor As Object
            Set iColor = Colors.Item(Clr%)
            Circ.Color iColor
            Set iColor = Nothing
        End If

        If Regen% <> 0 Then
            Circ.Regen
        End If

        VerifyCircle Circ, X#, Y#, R#, Lyr$, Clr%
        Set Circ = Nothing                          ' release the automation objects
    End If
End Sub
Sub DrawFace(X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%, Regen%)
'
'   draws a face
'

'
'   X#, Y# 1-4  are the faces coordinates
'   L$          is the layer
'   C%          is the color
'   Reg%        is whether to regen when done or not
'
    If (Not Entities Is Nothing) Then
        Dim iFace As Object                         ' the Face itself
        Dim iWhere As Object                        ' the various properties of the Face

        Set iFace = Entities.AddFace                ' create the Face

        If (Not iFace Is Nothing) Then              ' if the Face created successfully....
            Set iWhere = iFace.Where(1)             ' get a point
            iWhere.X = X1
            iWhere.Y = Y1
            Set iFace.Where(1) = iWhere             ' set point 1

            iWhere.X = X2
            iWhere.Y = Y2
            Set iFace.Where(2) = iWhere             ' set point 2

            iWhere.X = X3
            iWhere.Y = Y3
            Set iFace.Where(3) = iWhere             ' set point 3

            iWhere.X = X4
            iWhere.Y = Y4
            Set iFace.Where(4) = iWhere             ' set point 4
            Set iWhere = Nothing

            If (Len(Lyr$) > 0) Then
                iFace.Layer Layers.Item(Lyr$)       ' switch Face to the given layer
            End If

            If (Clr% > -1) Then                     ' switch Face to the given color
                Dim iColor As Object
                Set iColor = Colors.Item(Clr%)
                iFace.Color iColor
                Set iColor = Nothing
            End If

            If Regen% <> 0 Then                     ' regen the new Face if supposed to
                iFace.Regen
            End If

            VerifyFace iFace, X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%
            Set iFace = Nothing
        Else
            Debug.Print "Face creation failed !!!!"
        End If
    Else
        Debug.Print "Can't create Face.  Entities object is not valid"
    End If
End Sub

Sub DrawPoint(X#, Y#, Lyr$, Clr%, Regen%)
'
'   creates an Point
'

'
'   X#, Y#  are the point's coordinates
'   L$      is the layer
'   C%      is the color
'   Reg%    is whether to regen when done or not
'
    If (Not Entities Is Nothing) Then
        Dim iPoint As Object                      ' the Point itself
        Dim iWhere As Object                      ' the various properties of the Point

        Set iPoint = Entities.AddPoint            ' create the Point

        If (Not iPoint Is Nothing) Then           ' if the Point created successfully....
            Set iWhere = iPoint.Where             ' set the center point of the Point
            iWhere.X = X
            iWhere.Y = Y
            iPoint.Where iWhere
            Set iWhere = Nothing

            If (Len(Lyr$) > 0) Then
                iPoint.Layer Layers.Item(Lyr$)    ' switch Point to the given layer
            End If

            If (Clr% > -1) Then                   ' switch Point to the given color
                Dim iColor As Object
                Set iColor = Colors.Item(Clr%)
                iPoint.Color iColor
                Set iColor = Nothing
            End If

            If Regen% <> 0 Then                    ' regen the new Point if supposed to
                iPoint.Regen
            End If

            VerifyPoint iPoint, X#, Y#, Lyr$, Clr%
            Set iPoint = Nothing
        Else
            Debug.Print "Point creation failed !!!!"
        End If
    Else
        Debug.Print "Can't create Point.  Entities object is not valid"
    End If
End Sub

Sub DrawPolyline(ByVal oList As Object, Lyr$, Clr%, Regen%)
'
'   draws a line with the given parameters
'   to indicated layer (Lyr$), Color (Clr%)
'
'   If Lyr$ is an empty string, then the active layer is used
'   if Clr% = -1, then the color is ByLayer
'
    If oList.ListCount < 1 Then
        Debug.Print "DrawPolyline() -- no verticies in the listbox"
        Exit Sub
    End If

    Debug.Print "DrawPolyline() -- polylines cause Server Exceptions"
    Exit Sub

    If ((Not Layers Is Nothing) And (Not Entities Is Nothing)) Then
        Dim iLine As Object, Pt As Object           ' line and its points
        Dim iVerticies As Object                     ' the verticies for the polyline
        Dim iVertex As Object                       ' each vertex on the polyline
        Dim iPt As Object                           ' the actual point data for the vertex
        Dim i%, X#, Y#, C$
        Set iLine = Entities.AddPolyline()          ' create the new line
        Set iVerticies = iLine.Verticies

        For i% = 0 To oList.ListCount               ' create all the verticies in the list box
            C$ = oList.List(i%)
            ParseCoords X, Y, C$

            Set iVertex = iVerticies.Add            ' add the new vertex
            Set iPt = iVertex.Where

            iPt.X = X                               ' the coordinates
            iPt.Y = Y
            iVertex.Where iPt                       ' set the point data back in to the vertex

            Set iPt = Nothing                       ' clear the objects, to avoid memory leaks
            Set iVertex = Nothing
        Next
        Set iVerticies = Nothing

        If (Clr% > -1) Then                         ' switch line to the given color
            Dim iColor As Object
            Set iColor = Colors.Item(Clr%)
            iLine.Color iColor
            Set iColor = Nothing
        End If

        If (Regen% <> 0) Then
            iLine.Regen
        End If

        VerifyPolyline iLine, oList, Lyr$, Clr%
        Set iLine = Nothing                         ' release the automation objects
    End If
End Sub

Sub DrawSolid(X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%, Regen%)
'
'   draws a Solid
'

'
'   X#, Y# 1-4  are the Solids coordinates
'   L$          is the layer
'   C%          is the color
'   Reg%        is whether to regen when done or not
'
    If (Not Entities Is Nothing) Then
        Dim iSolid As Object                        ' the Solid itself
        Dim iWhere As Object                        ' the various properties of the Solid

        Set iSolid = Entities.AddSolid              ' create the Solid

        If (Not iSolid Is Nothing) Then             ' if the Solid created successfully....
            Set iWhere = iSolid.Where(1)            ' get a point
            iWhere.X = X1
            iWhere.Y = Y1
            Set iSolid.Where(1) = iWhere            ' set point 1

            iWhere.X = X2
            iWhere.Y = Y2
            Set iSolid.Where(2) = iWhere            ' set point 2

            iWhere.X = X3
            iWhere.Y = Y3
            Set iSolid.Where(3) = iWhere            ' set point 3

            iWhere.X = X4
            iWhere.Y = Y4
            Set iSolid.Where(4) = iWhere            ' set point 4
            Set iWhere = Nothing

            If (Len(Lyr$) > 0) Then
                iSolid.Layer Layers.Item(Lyr$)      ' switch Solid to the given layer
            End If

            If (Clr% > -1) Then                     ' switch Solid to the given color
                Dim iColor As Object
                Set iColor = Colors.Item(Clr%)
                iSolid.Color iColor
                Set iColor = Nothing
            End If

            If Regen% <> 0 Then                     ' regen the new Solid if supposed to
                iSolid.Regen
            End If

            VerifySolid iSolid, X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%
            Set iSolid = Nothing
        Else
            Debug.Print "Solid creation failed !!!!"
        End If
    Else
        Debug.Print "Can't create Solid.  Entities object is not valid"
    End If
End Sub
Sub DrawTrace(X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%, Regen%)
'
'   draws a Trace
'

'
'   X#, Y# 1-4  are the Traces coordinates
'   L$          is the layer
'   C%          is the color
'   Reg%        is whether to regen when done or not
'
    If (Not Entities Is Nothing) Then
        Dim iTrace As Object                         ' the Trace itself
        Dim iWhere As Object                         ' the various properties of the Trace

        Set iTrace = Entities.AddTrace               ' create the Trace

        If (Not iTrace Is Nothing) Then              ' if the Trace created successfully....
            Set iWhere = iTrace.Where(1)             ' get a point
            iWhere.X = X1
            iWhere.Y = Y1
            Set iTrace.Where(1) = iWhere             ' set point 1

            iWhere.X = X2
            iWhere.Y = Y2
            Set iTrace.Where(2) = iWhere             ' set point 2

            iWhere.X = X3
            iWhere.Y = Y3
            Set iTrace.Where(3) = iWhere             ' set point 3

            iWhere.X = X4
            iWhere.Y = Y4
            Set iTrace.Where(4) = iWhere             ' set point 4
            Set iWhere = Nothing

            If (Len(Lyr$) > 0) Then
                iTrace.Layer Layers.Item(Lyr$)       ' switch Trace to the given layer
            End If

            If (Clr% > -1) Then                     ' switch Trace to the given color
                Dim iColor As Object
                Set iColor = Colors.Item(Clr%)
                iTrace.Color iColor
                Set iColor = Nothing
            End If

            If Regen% <> 0 Then                     ' regen the new Trace if supposed to
                iTrace.Regen
            End If

            VerifyTrace iTrace, X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%
            Set iTrace = Nothing
        Else
            Debug.Print "Trace creation failed !!!!"
        End If
    Else
        Debug.Print "Can't create Trace.  Entities object is not valid"
    End If
End Sub
Sub GenerateRandomPLine()
'
'   generates a random collection of polyline vertex
'   points.  Mainly useful for the automated polyline
'   generation routines.
'
    Dim C$, X#, Y#, v%, i%
    Dim LX#, LY#, UX#, UY#

    v% = 0
    While v% < 2
        v% = Int(100 * Rnd)             ' up to 100 vertex points
    Wend

    For i% = 0 To v%
    '
    '   create the X and Y coords, but stay within the specified extents
        ParseCoords UX, UY, EntCreationForm.ectUpperExtents.Text
        ParseCoords LX, LY, EntCreationForm.ectLowerExtents.Text

        X = (((UX - LX + 1) * Rnd) + LX)
        Y = (((UY - LY + 1) * Rnd) + LY)

        C$ = Trim$(Format$(X, "#.##")) & "," & Trim$(Format$(Y, "#.##"))
        ECOForm.ecoPolylinePtList.AddItem C$
    Next
End Sub


Sub ParseCoords(X#, Y#, K$)
'
'   parse the given string into X and Y coordinates
'   allows for only one coordinate to be present,
'   either first or second
'
    X# = 0#
    Y# = 0#

    Dim pComma As Integer
    pComma = InStr(K$, ",")
    If (pComma = 1) Then                ' second coordinate only
        Y# = CDbl(Val(Mid$(K$, pComma + 1)))
    Else
        If (pComma <> 0) Then
            X# = Val(Left$(K$, pComma - 1))
            Y# = Val(Mid$(K$, pComma + 1))
        Else
            X# = CDbl(Val(K$))          ' no second coordinate
        End If
    End If
End Sub

Sub DrawLine(X1#, Y1#, X2#, Y2#, Lyr$, Clr%, Regen%)
'
'   draws a line with the given parameters
'   to indicated layer (Lyr$), Color (Clr%)
'
'   If Lyr$ is an empty string, then the active layer is used
'   if Clr% = -1, then the color is ByLayer
'
    If ((Not Layers Is Nothing) And (Not Entities Is Nothing)) Then
        Dim Line As Object, Pt As Object            ' line and its points

        Set Line = Entities.AddLine()               ' create the new line

        Set Pt = Line.Where1                        ' start point of line
        Pt.X = X1#
        Pt.Y = Y1#
        Line.Where1 Pt
        Set Pt = Nothing

        Set Pt = Line.Where2                        ' end point of line
        Pt.X = X2#
        Pt.Y = Y2#
        Line.Where2 Pt
        Line.Regen
        Set Pt = Nothing

        If (Len(Lyr$) > 0) Then
            Line.Layer Layers.Item(Lyr$)            ' switch line to the given layer
        End If

        If (Clr% > -1) Then                         ' switch line to the given color
            Dim iColor As Object
            Set iColor = Colors.Item(Clr%)
            Line.Color iColor
            Set iColor = Nothing
        End If

        If (Regen% <> 0) Then
            Line.Regen
        End If

        VerifyLine Line, X1#, Y1#, X2#, Y2#, Lyr$, Clr%

        Set Line = Nothing                          ' release the automation objects
    End If
End Sub

Sub InitEntitiesArray()
'
'   set up the entities array
'
    gblEntities(0) = "Arc"
    gblEntities(1) = "Attdef"
    gblEntities(2) = "Block Insert"
    gblEntities(3) = "Circle"
    gblEntities(4) = "Dim, Hor"
    gblEntities(5) = "Dim, Rad"
    gblEntities(6) = "Dim, Ver"
    gblEntities(7) = "Face"
    gblEntities(8) = "Line"
    gblEntities(9) = "Point"
    gblEntities(10) = "Polyline"
    gblEntities(11) = "Shape"
    gblEntities(12) = "Solid"
    gblEntities(13) = "Start Center Angle ???"
    gblEntities(14) = "Start Insert ???"
    gblEntities(15) = "Start Line ???"
    gblEntities(16) = "Text"
    gblEntities(17) = "Trace"
    gblEntities(18) = "Viewport"
End Sub

Sub InitVdraft()
'
'   check if Vdraft is up or not and, if it is
'   grab all the global objects.  If there is
'   no active drawing, then create one.  Also
'   fills in the Current Drawings listbox with
'   all the current drawings, if any.
'
    Screen.MousePointer = 11
    ReleaseVdraft                       ' clear all global objects
    MainForm.ActiveDrawing.Caption = ""
    MainForm.ActiveDrawingsList.Clear
    MainForm.VdraftStatus.Caption = ""
    MainForm.VdraftStatus2.Caption = ""

'
'   attempt to get the Vdraft Object
    Dim Cntr%
    Cntr% = 0

    On Error GoTo InitVdraft_Err1
InitVdraft_Loop1:
    Set Vdraft = CreateObject("Vdraft.Application")
    GoTo InitVdraft_Cont1

InitVdraft_Err1:
    Cntr% = Cntr% + 1
    If (Cntr% < 10) Then GoTo InitVdraft_Loop1
    MsgBox "Error -- Unable to open Vdraft"
    MainForm.VdraftStatus.Caption = "Vdraft is not available"
    MainForm.VdraftStatus2.Caption = "Vdraft is not available"
    MainForm.StatusBar.Panels(1).Text = "Vdraft was not opened"
    Resume InitVdraft_Exit

InitVdraft_Cont1:
    On Error GoTo 0
    Set Docs = Vdraft.Documents

    On Error GoTo InitVdraft_Err2
    Set Doc = Vdraft.ActiveDocument
    GoTo InitVdraft_Cont2

InitVdraft_Err2:
    MsgBox "Error -- No Active Document found"
    Resume InitVdraft_Cont2

InitVdraft_Cont2:
    On Error GoTo 0
    If ValidateDok() Then
        Set Entities = Doc.Entities
        Set Units = Doc.Units
        Set Commands = Doc.Commands
        Set EntitySnap = Doc.EntitySnap
        Set Layers = Doc.Layers
        Set LineTypes = Doc.LineTypes
        Set Colors = Doc.Colors
        Set TextStyles = Doc.TextStyles
    End If

InitVdraft_Exit:
    On Error GoTo 0
    UpdateGlobalObjs
    Screen.MousePointer = 0
End Sub

Sub UpdateGlobalObjs()
'
'   update the displays showing status Vdraft, the
'   global objs, et al...
'
    IsGlobalUpdating = True
    MainForm.GlobalObjsList.Clear
    If ValidateVdraft() Then
        MainForm.GlobalObjsList.AddItem "x Vdraft"
        MainForm.VdraftStatus.Caption = "Vdraft is Open"
        MainForm.VdraftStatus2.Caption = "Vdraft is Open"
        MainForm.EndCmd.Enabled = True
        MainForm.CloseCmd.Enabled = True
        MainForm.LoadDwgCmd.Enabled = True
        MainForm.NewDwgCmd.Enabled = True
        MainForm.RunCmd.Enabled = True
        MainForm.RunAllCmd.Enabled = True
        MainForm.ExecuteCmd.Enabled = True
        MainForm.OpenCmd(0).Enabled = True
        MainForm.OpenCmd(1).Enabled = True
        MainForm.ReleaseCmd.Enabled = True
        MainForm.GrabCmd.Enabled = True
    Else
        MainForm.GlobalObjsList.AddItem "  Vdraft"
        MainForm.VdraftStatus.Caption = "Vdraft is not Open"
        MainForm.VdraftStatus2.Caption = "Vdraft is not Open"
        MainForm.EndCmd.Enabled = False
        MainForm.CloseCmd.Enabled = False
        MainForm.LoadDwgCmd.Enabled = False
        MainForm.NewDwgCmd.Enabled = False
        MainForm.RunCmd.Enabled = False
        MainForm.RunAllCmd.Enabled = False
        MainForm.ExecuteCmd.Enabled = False
        MainForm.ReleaseCmd.Enabled = False
        MainForm.GrabCmd.Enabled = False
    End If

    If (Not Colors Is Nothing) Then
        MainForm.GlobalObjsList.AddItem "x Colors"
    Else
        MainForm.GlobalObjsList.AddItem "  Colors"
    End If

    If (Not Commands Is Nothing) Then
        MainForm.GlobalObjsList.AddItem "x Commands"
    Else
        MainForm.GlobalObjsList.AddItem "  Commands"
    End If

    If ValidateDok() Then
        MainForm.GlobalObjsList.AddItem "x Doc"
    Else
        MainForm.GlobalObjsList.AddItem "  Doc"
    End If

    If ValidateVdraft() Then
        MainForm.GlobalObjsList.AddItem "x Docs"
    Else
        MainForm.GlobalObjsList.AddItem "  Docs"
    End If

    If (Not Entities Is Nothing) Then
        MainForm.GlobalObjsList.AddItem "x Entities"
    Else
        MainForm.GlobalObjsList.AddItem "  Entities"
    End If

    If (Not EntitySnap Is Nothing) Then
        MainForm.GlobalObjsList.AddItem "x EntitySnap"
    Else
        MainForm.GlobalObjsList.AddItem "  EntitySnap"
    End If

    If (Not Layers Is Nothing) Then
        MainForm.GlobalObjsList.AddItem "x Layers"
    Else
        MainForm.GlobalObjsList.AddItem "  Layers"
    End If

    If (Not LineTypes Is Nothing) Then
        MainForm.GlobalObjsList.AddItem "x Linetypes"
    Else
        MainForm.GlobalObjsList.AddItem "  Linetypes"
    End If

    If (Not TextStyles Is Nothing) Then
        MainForm.GlobalObjsList.AddItem "x TextStyles"
    Else
        MainForm.GlobalObjsList.AddItem "  TextStyles"
    End If

    If (Not Units Is Nothing) Then
        MainForm.GlobalObjsList.AddItem "x Units"
    Else
        MainForm.GlobalObjsList.AddItem "  Units"
    End If

'
'   update the list of current drawings.
'    Dim prev$
'    prev$ = ""
'    If (MainForm.ActiveDrawingsList.ListIndex <> -1) Then
'    '   save the existing highlight, if there is one
'        prev$ = MainForm.ActiveDrawingsList.List(MainForm.ActiveDrawingsList.ListIndex)
'    End If
'
'    MainForm.ActiveDrawingsList.Clear
'    If (Not Docs Is Nothing) Then
'        Dim i%, j%
'        Dim Dok As Object
'        i% = Docs.Count
'        For j% = 1 To i%
'            Set Dok = Docs.Item(j%)
'            MainForm.ActiveDrawingsList.AddItem Dok.Name
'            Set Dok = Nothing
'        Next
'    End If
'
'    If (prev$ <> "") Then
'    '   restore the previous highlight
'        If (MainForm.ActiveDrawingsList.ListCount > 0) Then
'            For i% = 0 To MainForm.ActiveDrawingsList.ListCount
'                If (MainForm.ActiveDrawingsList.List(MainForm.ActiveDrawingsList.ListIndex) = prev$) Then
'                    MainForm.ActiveDrawingsList.ListIndex = i%
'                    Exit For
'                End If
'            Next
'        End If
'    End If

    With MainForm.ActiveDrawingsList
        Dim prev$
        prev$ = ""
        If (.ListIndex <> -1) Then
        '   save the existing highlight, if there is one
            prev$ = .List(.ListIndex)
        End If

        .Clear
    '   get all the current drawings from Vdraft
        If (Not Docs Is Nothing) Then
            Dim i%, j%
            Dim Dok As Object
            i% = Docs.Count
            For j% = 1 To i%
                Set Dok = Docs.Item(j%)
                .AddItem Dok.Name
                Set Dok = Nothing
            Next
        End If

        If (prev$ <> "") Then
        '   restore the previous highlight
            If (.ListCount > 0) Then
                For i% = 0 To .ListCount
                    If (UCase$(Trim$(.List(i%))) = UCase$(Trim$(prev$))) Then
                        .ListIndex = i%
                        Exit For
                    End If
                Next
            End If
        End If
    End With

'
'   the active drawing
    MainForm.ActiveDrawing.Caption = "No Active Drawing"
    MainForm.DwgFullName.Text = ""
    MainForm.DwgName.Text = ""
    MainForm.DwgPath.Text = ""
    MainForm.DwgSaved.Caption = ""
    If ValidateDok() Then
        MainForm.ActiveDrawing.Caption = "Active Drawing is '" & Doc.Fullname & "'"
        MainForm.DwgFullName.Text = Doc.Fullname
        MainForm.DwgName.Text = Doc.Name
        MainForm.DwgPath.Text = Doc.Path
        If (Doc.Saved = False) Then
            MainForm.DwgSaved.Caption = "No"
        Else
            MainForm.DwgSaved.Caption = "Yes"
        End If
    End If

'
'   the undo list
    UpdateUndoList

'
'   the number of entities in the current drawing
    If (Not Entities Is Nothing) Then
        MainForm.NumOfEntities.Caption = Str$(Entities.Count)
    Else
        MainForm.NumOfEntities.Caption = ""
    End If


    IsGlobalUpdating = False
End Sub
Function ValidateDok() As Integer
'
'   verify that the object refers to a live, real, breathing document
'
    If (Doc Is Nothing) Then
        ValidateDok = False
        GoTo ValidateDok_Exit
    End If
    On Error GoTo ValidateDok_Err

    Dim n$
    n$ = Space(250)
    n$ = Doc.Name               ' it will fail here or not

    ValidateDok = True          ' did not fail
    GoTo ValidateDok_Exit

ValidateDok_Err:
    ValidateDok = False         ' did fail.  Assume faulty pointer
    MainForm.StatusBar.Panels(1).Text = "'Doc' object is invalid"
    Resume ValidateDok_Exit

ValidateDok_Exit:
    On Error GoTo 0
End Function
Sub ReleaseVdraft()
'
'   release all the global Vdraft Objects
'
    Set Vdraft = Nothing
    Set Docs = Nothing
    Set Doc = Nothing
    Set Entities = Nothing
    Set Units = Nothing
    Set Commands = Nothing
    Set EntitySnap = Nothing

    UpdateGlobalObjs
End Sub



Sub UpdateUndoList()
'
'   update the undo list tab page
'
    MainForm.UndoCount = ""
    MainForm.UndoList.Clear
    If (Not Commands Is Nothing) Then
        Dim i, C%, Cmd As Object
        C% = Commands.Count
        MainForm.UndoCount = "There are " & Trim$(Str$(C%)) & " entries in the Undo List"
        For i = 1 To C%
            Set Cmd = Commands.Item(i)
            MainForm.UndoList.AddItem Cmd.Description
            Set Cmd = Nothing
        Next
        MainForm.UndoList.ListIndex = -1            ' highlight nothing
    End If
End Sub


Function ValidateVdraft() As Integer
'
'   verify that the Vdraft object is alive and well
'
    If Vdraft Is Nothing Then
        ValidateVdraft = False
        GoTo ValidateVdraft_Exit
    End If
    On Error GoTo ValidateVdraft_Err

    Dim n$
    n$ = Space(250)
    n$ = Vdraft.Name                ' it will fail here or not

    ValidateVdraft = True           ' did not fail
    GoTo ValidateVdraft_Exit

ValidateVdraft_Err:
    ValidateVdraft = False          ' did fail.  Assume faulty pointer
    MainForm.StatusBar.Panels(1).Text = "'Vdraft' object is invalid"
    Resume ValidateVdraft_Exit

ValidateVdraft_Exit:
    On Error GoTo 0
End Function

Sub VerifyArc(ByVal iArc As Object, X#, Y#, R#, S#, E#, Lyr$, Clr%)
'
'   verifies that the given object is an arc and has
'   the specified parameters
'

'
'   X#, Y#  are the center point
'   R#      is the radius
'   S#      is the start angle  (in radians)
'   E#      is the end angle    (in radians)
'   L$      is the layer
'   C%      is the color
'
    Dim eMsg$
    eMsg$ = "VerifyArc()" & CRLF & "Arc does not have the indicated "


    If (iArc Is Nothing) Then
        Debug.Print "VerifyArc() -- iArc is not an object !"
        MsgBox "VerifyArc()" & CRLF & "Huffffff!  Not even close."
        ERROR_COUNT = ERROR_COUNT + 1
    Else
        If (iArc.Type <> 8) Then
            MsgBox "VerifyArc()" & CRLF & "Object is not an ARC !"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        Dim iCenter As Object
        Set iCenter = iArc.Center
        If iCenter.X <> X# Or iCenter.Y <> Y# Then
            MsgBox eMsg$ & " center point"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iCenter = Nothing

        If iArc.Radius <> R# Then
            MsgBox eMsg$ & "radius"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        If iArc.StartAngle <> S# Then
            MsgBox eMsg$ & "start angle"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        If iArc.EndAngle <> E# Then
            MsgBox eMsg$ & "end angle"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        If (Len(Lyr$) > 0) Then
            Dim iLayer As Object
            Set iLayer = iArc.Layer
            If iLayer.Name <> Lyr$ Then
                MsgBox eMsg$ & "layer"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iLayer = Nothing
        End If

        If (Clr% <> -1) Then
            Dim iColor As Object
            Set iColor = iArc.Color
            If iColor.Number <> Clr% Then
                MsgBox eMsg$ & "color"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iColor = Nothing
        End If
    End If
End Sub


Sub VerifyCircle(ByVal iCircle As Object, X#, Y#, R#, Lyr$, Clr%)
'
'   verifies that the given object is a Circle and has
'   the specified parameters
'

'
'   X#, Y#  are the center point
'   R#      is the radius
'   L$      is the layer
'   C%      is the color
'
    Dim eMsg$
    eMsg$ = "VerifyCircle()" & CRLF & "Circle does not have the indicated "


    If (iCircle Is Nothing) Then
        Debug.Print "VerifyCircle() -- iCircle is not an object !"
        MsgBox "VerifyCircle()" & CRLF & "Huffffff!  Not even close."
        ERROR_COUNT = ERROR_COUNT + 1
    Else
        If (iCircle.Type <> 3) Then
            MsgBox "VerifyCircle()" & CRLF & "Object is not an Circle !"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        Dim iCenter As Object
        Set iCenter = iCircle.Center
        If iCenter.X <> X# Or iCenter.Y <> Y# Then
            MsgBox eMsg$ & " center point"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iCenter = Nothing

        If iCircle.Radius <> R# Then
            MsgBox eMsg$ & "radius"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        If (Len(Lyr$) > 0) Then
            Dim iLayer As Object
            Set iLayer = iCircle.Layer
            If iLayer.Name <> Lyr$ Then
                MsgBox eMsg$ & "layer"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iLayer = Nothing
        End If

        If (Clr% <> -1) Then
            Dim iColor As Object
            Set iColor = iCircle.Color
            If iColor.Number <> Clr% Then
                MsgBox eMsg$ & "color"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iColor = Nothing
        End If
    End If
End Sub

Sub VerifyFace(ByVal iFace As Object, X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%)
'
'   verifies that the given object is a Face and has
'   the specified parameters
'

'
'   X#, Y#  are the center point
'   R#      is the radius
'   S#      is the start angle  (in radians)
'   E#      is the end angle    (in radians)
'   L$      is the layer
'   C%      is the color
'
    Dim eMsg$
    eMsg$ = "VerifyFace()" & CRLF & "Face does not have the indicated "

    If (iFace Is Nothing) Then
        Debug.Print "VerifyFace() -- iFace is not an object !"
        MsgBox "VerifyFace()" & CRLF & "Huffffff!  Not even close."
        ERROR_COUNT = ERROR_COUNT + 1
    Else
        If (iFace.Type <> 22) Then
            MsgBox "VerifyFace()" & CRLF & "Object is not an Face !"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        Dim iWhere As Object
        Set iWhere = iFace.Where(1)
        If (iWhere.X <> X1# Or iWhere.Y <> Y1#) Then
            MsgBox eMsg & " vertex point 1"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iFace.Where(2)
        If (iWhere.X <> X2# Or iWhere.Y <> Y2#) Then
            MsgBox eMsg & " vertex point 2"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iFace.Where(3)
        If (iWhere.X <> X3# Or iWhere.Y <> Y3#) Then
            MsgBox eMsg & " vertex point 3"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iFace.Where(4)
        If (iWhere.X <> X4# Or iWhere.Y <> Y4#) Then
            MsgBox eMsg & " vertex point 4"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        If (Len(Lyr$) > 0) Then
            Dim iLayer As Object
            Set iLayer = iFace.Layer
            If iLayer.Name <> Lyr$ Then
                MsgBox eMsg$ & "layer"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iLayer = Nothing
        End If

        If (Clr% <> -1) Then
            Dim iColor As Object
            Set iColor = iFace.Color
            If iColor.Number <> Clr% Then
                MsgBox eMsg$ & "color"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iColor = Nothing
        End If
    End If
End Sub

Sub VerifyLine(ByVal iLine As Object, X1#, Y1#, X2#, Y2#, Lyr$, Clr%)
'
'   verifies that the given object is a line and has
'   the specified parameters
'

'
'   X1#, Y1# is the start point
'   X2#, Y2# is the end point
'   Lyr$     is the layer
'   Clr%     is the color
'
    Dim eMsg$
    eMsg$ = "VerifyLine()" & CRLF & "Line does not have the indicated "

    If (iLine Is Nothing) Then
        Debug.Print "VerifyLine() -- iLine is not an object !"
        MsgBox "VerifyLine()" & CRLF & "Huffffff!  Not even close."
        ERROR_COUNT = ERROR_COUNT + 1
    Else
        If (iLine.Type <> 1) Then
            MsgBox "VerifyLine()" & CRLF & "Object is not a Line !"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        Dim iWhere1 As Object
        Set iWhere1 = iLine.Where1
        If iWhere1.X <> X1# Or iWhere1.Y <> Y1# Then
            MsgBox eMsg$ & "start point"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere1 = Nothing

        Dim iWhere2 As Object
        Set iWhere2 = iLine.Where2
        If iWhere2.X <> X2# Or iWhere2.Y <> Y2# Then
            MsgBox eMsg$ & "start point"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere2 = Nothing

        If (Len(Lyr$) > 0) Then
            Dim iLayer As Object
            Set iLayer = iLine.Layer
            If iLayer.Name <> Lyr$ Then
                MsgBox eMsg$ & "layer"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iLayer = Nothing
        End If

        If (Clr% <> -1) Then
            Dim iColor As Object
            Set iColor = iLine.Color
            If iColor.Number <> Clr% Then
                MsgBox eMsg$ & "color"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iColor = Nothing
        End If
    End If
End Sub


Sub VerifyPoint(ByVal iPoint As Object, X#, Y#, Lyr$, Clr%)
'
'   verifies that the given object is a Point and has
'   the specified parameters

'
'   X#, Y#  are the center point
'   L$      is the layer
'   C%      is the color
'
    Dim eMsg$
    eMsg$ = "VerifyPoint()" & CRLF & "Point does not have the indicated "


    If (iPoint Is Nothing) Then
        Debug.Print "VerifyPoint() -- iPoint is not an object !"
        MsgBox "VerifyPoint()" & CRLF & "Huffffff!  Not even close."
        ERROR_COUNT = ERROR_COUNT + 1
    Else
        If (iPoint.Type <> 2) Then
            MsgBox "VerifyPoint()" & CRLF & "Object is not a Point !"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        Dim iWhere As Object
        Set iWhere = iPoint.Where
        If iWhere.X <> X# Or iWhere.Y <> Y# Then
            MsgBox eMsg$ & " coordinates"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        If (Len(Lyr$) > 0) Then
            Dim iLayer As Object
            Set iLayer = iPoint.Layer
            If iLayer.Name <> Lyr$ Then
                MsgBox eMsg$ & "layer"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iLayer = Nothing
        End If

        If (Clr% <> -1) Then
            Dim iColor As Object
            Set iColor = iPoint.Color
            If iColor.Number <> Clr% Then
                MsgBox eMsg$ & "color"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iColor = Nothing
        End If
    End If
End Sub


Sub VerifyPolyline(ByVal iLine As Object, ByVal oList As Object, Lyr$, Clr%)
'
'   verifies that the given object is an Polyline and has
'   the specified parameters
'

'
'   X#, Y#  are the center point
'   R#      is the radius
'   S#      is the start angle  (in radians)
'   E#      is the end angle    (in radians)
'   L$      is the layer
'   C%      is the color
'
    Dim eMsg$
    eMsg$ = "VerifyPolyline()" & CRLF & "Polyline does not have the indicated "


    If (iPolyline Is Nothing) Then
        Debug.Print "VerifyPolyline() -- iPolyline is not an object !"
        MsgBox "VerifyPolyline()" & CRLF & "Huffffff!  Not even close."
        ERROR_COUNT = ERROR_COUNT + 1
    Else
        If (iPolyline.Type <> 19) Then
            MsgBox "VerifyPolyline()" & CRLF & "Object is not a Polyline !"
            ERROR_COUNT = ERROR_COUNT + 1
        End If


    Debug.Print "VerifyPolyline() --  not finished"


        If (Len(Lyr$) > 0) Then
            Dim iLayer As Object
            Set iLayer = iPolyline.Layer
            If iLayer.Name <> Lyr$ Then
                MsgBox eMsg$ & "layer"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iLayer = Nothing
        End If

        If (Clr% <> -1) Then
            Dim iColor As Object
            Set iColor = iPolyline.Color
            If iColor.Number <> Clr% Then
                MsgBox eMsg$ & "color"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iColor = Nothing
        End If
    End If
End Sub


Sub VerifySolid(ByVal iSolid As Object, X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%)
'
'   verifies that the given object is a Solid and has
'   the specified parameters
'

'
'   X#, Y#  are the center point
'   R#      is the radius
'   S#      is the start angle  (in radians)
'   E#      is the end angle    (in radians)
'   L$      is the layer
'   C%      is the color
'
    Dim eMsg$
    eMsg$ = "VerifySolid()" & CRLF & "Solid does not have the indicated "

    If (iSolid Is Nothing) Then
        Debug.Print "VerifySolid() -- iSolid is not an object !"
        MsgBox "VerifySolid()" & CRLF & "Huffffff!  Not even close."
        ERROR_COUNT = ERROR_COUNT + 1
    Else
        If (iSolid.Type <> 11) Then
            MsgBox "VerifySolid()" & CRLF & "Object is not a Solid !"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        Dim iWhere As Object
        Set iWhere = iSolid.Where(1)
        If (iWhere.X <> X1# Or iWhere.Y <> Y1#) Then
            MsgBox eMsg & " vertex point 1"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iSolid.Where(2)
        If (iWhere.X <> X2# Or iWhere.Y <> Y2#) Then
            MsgBox eMsg & " vertex point 2"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iSolid.Where(3)
        If (iWhere.X <> X3# Or iWhere.Y <> Y3#) Then
            MsgBox eMsg & " vertex point 3"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iSolid.Where(4)
        If (iWhere.X <> X4# Or iWhere.Y <> Y4#) Then
            MsgBox eMsg & " vertex point 4"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        If (Len(Lyr$) > 0) Then
            Dim iLayer As Object
            Set iLayer = iSolid.Layer
            If iLayer.Name <> Lyr$ Then
                MsgBox eMsg$ & "layer"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iLayer = Nothing
        End If

        If (Clr% <> -1) Then
            Dim iColor As Object
            Set iColor = iSolid.Color
            If iColor.Number <> Clr% Then
                MsgBox eMsg$ & "color"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iColor = Nothing
        End If
    End If
End Sub


Sub VerifyTrace(ByVal iTrace As Object, X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Lyr$, Clr%)
'
'   verifies that the given object is a Trace and has
'   the specified parameters
'

'
'   X#, Y#  are the center point
'   R#      is the radius
'   S#      is the start angle  (in radians)
'   E#      is the end angle    (in radians)
'   L$      is the layer
'   C%      is the color
'
    Dim eMsg$
    eMsg$ = "VerifyTrace()" & CRLF & "Trace does not have the indicated "

    If (iTrace Is Nothing) Then
        Debug.Print "VerifyTrace() -- iTrace is not an object !"
        MsgBox "VerifyTrace()" & CRLF & "Huffffff!  Not even close."
        ERROR_COUNT = ERROR_COUNT + 1
    Else
        If (iTrace.Type <> 9) Then
            MsgBox "VerifyTrace()" & CRLF & "Object is not a Trace !"
            ERROR_COUNT = ERROR_COUNT + 1
        End If

        Dim iWhere As Object
        Set iWhere = iTrace.Where(1)
        If (iWhere.X <> X1# Or iWhere.Y <> Y1#) Then
            MsgBox eMsg & " vertex point 1"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iTrace.Where(2)
        If (iWhere.X <> X2# Or iWhere.Y <> Y2#) Then
            MsgBox eMsg & " vertex point 2"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iTrace.Where(3)
        If (iWhere.X <> X3# Or iWhere.Y <> Y3#) Then
            MsgBox eMsg & " vertex point 3"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        Set iWhere = iTrace.Where(4)
        If (iWhere.X <> X4# Or iWhere.Y <> Y4#) Then
            MsgBox eMsg & " vertex point 4"
            ERROR_COUNT = ERROR_COUNT + 1
        End If
        Set iWhere = Nothing

        If (Len(Lyr$) > 0) Then
            Dim iLayer As Object
            Set iLayer = iTrace.Layer
            If iLayer.Name <> Lyr$ Then
                MsgBox eMsg$ & "layer"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iLayer = Nothing
        End If

        If (Clr% <> -1) Then
            Dim iColor As Object
            Set iColor = iTrace.Color
            If iColor.Number <> Clr% Then
                MsgBox eMsg$ & "color"
                ERROR_COUNT = ERROR_COUNT + 1
            End If
            Set iColor = Nothing
        End If
    End If
End Sub