Chip 1997 January/Chip_1997-01_cd.bin/ms95/disk21/dir04/f000990.re_/f000990.re

Text File | 1996-04-02 | 12KB | 329 lines

Attribute VB_Name = "locate"
' Example of element location techniques
'--------------------------------------------------------------------
'--------------------------------------------------------------------
'
'  Copyright (1995) Bentley Systems, Inc., All rights reserved.
'
'   $Workfile:   locate.bas  $
'   $Revision:   6.0  $
'       $Date:   13 Sep 1995 11:50:48  $
'
'  "MicroStation" is a registered trademark of Bentley Systems, Inc.
'
'  Limited permission is hereby granted to reproduce and modify this
'  copyrighted material provided that the resulting code is used only
'  in conjunction with Bentley Systems products under the terms of the
'  license agreement provided therein, and that this notice is retained
'  in its entirety in any such reproduction or modification.
'
'--------------------------------------------------------------------
'
' This example uses a number of the MicroStation Basic Extension
' element location techniques. The actual manipulation that it
' performs on selected elements is very simple in this example, but
' the same technique could be used to implement a more sophisticated
' manipulation. Similarly, the filtering that it does during the
' element selection logic is simple, but the technique could be
' readily extended.
'
' This example looks fairly complicated because it emulates all of
' the behavior that MicroStation exhibits when it locates elements:
'
'  1. When you reject an element that is hilited, it keeps looking
'     around the data point for more elements that have not been
'     processed.
'  2. When you select an element and accept it with a point that
'     is close to the selection point, it looks for more
'     elements around the same point, skipping elements already
'     processed.
'  3. When you select an element and accept it with a point that
'     is not close to the selection point, it uses the accept
'     point to begin looking for more elements to process.
'
' In addition, it provides a step that filters elements so that only
' elements that are acceptable to the program are presented to the
' user for acceptance or rejection.
'
'--------------------------------------------------------------------

'---------------------------------------------------------------
'
'   locate_pointsCloseEnough - returns TRUE if points roughly
'       within the locate tolerance, FALSE otherwise
'
'---------------------------------------------------------------
Function locate_pointsCloseEnough(point1 As Object, point2 As Object) As Integer

    Dim MbeState As Object

    Set MbeState = msApp.MbeState

    If Abs(point1.x - point2.x) + Abs(point1.y - point2.y) _
            < MbeState.LocateTolerance Then
    locate_pointsCloseEnough = True
    End If
End Function


'---------------------------------------------------------------
'
'   locate_manipulateElement - performs the actual manipulation
'               on the selected element. This manipulation
'           sequences commands and uses the MbeRelocate
'       subroutine to make the command work on the
'       previously selected element
'
'---------------------------------------------------------------
Sub locate_manipulateElement(point As Object, view As Integer)

    Dim elem     As Object
    Dim filePos  As Long
    Dim MbeState As Object

    Set elem = msApp.MbeElement
    Set MbeState = msApp.MbeState

    ' turn off graphics while changing element
    MbeState.noElementDisplay = 1

    ' start change color and relocate element
    msApp.MbeSendCommand "CHANGE COLOR"
    msApp.MbeRelocate point, view
    msApp.MbeSendDataPoint point, view

    ' start change weight and relocate element
    msApp.MbeSendCommand "CHANGE WEIGHT"
    msApp.MbeRelocate point, view
    msApp.MbeSendDataPoint point, view

    ' relocate the manipulated element to reset the "locate context",
    ' so if we continue the locate, we'll continue with the next element
    ' before we do so, we set the command to something harmless, so
    ' the data point sent by MbeRelocate doesn't have the effect of
    ' changing the weight of an element that may have been selected
    ' by sending the accept data point to the CHANGE WEIGHT command.
    ' (NOTE: this section could have been shortened by substituting
    '        MbeRelocate for the above MbeSendDataPoint, but this
    '        looks a bit confusing).
    msApp.MbeSendCommand "LOCELE"
    msApp.MbeRelocate point, view

    MbeState.noElementDisplay = 0

    ' get the element to redraw it with its new symbology
    filePos = elem.fromLocate()
    elem.display msApp.MBE_NormalDraw

    ' set MicroStation to a neutral state.
    msApp.MbeSendCommand "NULL"

End Sub


'---------------------------------------------------------------
'
'   locate_isElementAcceptable - returns TRUE if element passes
'               filter criteria and FALSE otherwise.
'
'---------------------------------------------------------------
Function locate_isElementAcceptable(elem As Object) As Integer
    If elem.type = msApp.MBE_Line Then
        locate_isElementAcceptable = True
    End If
End Function

'---------------------------------------------------------------
'
'   locate_elementUnacceptable - reports an error saying that
'               no acceptable element was located.
'
'---------------------------------------------------------------
Sub locate_elementUnacceptable()
    msApp.MbeWriteStatus "Only lines allowed"
End Sub

'---------------------------------------------------------------
'
'   locate_displayPrompts - tell the user what to identify
'
'---------------------------------------------------------------
Sub locate_displayPrompts()
    msApp.MbeWriteCommand "Locate Test "
    msApp.MbeWritePrompt "Identify line"
End Sub

'---------------------------------------------------------------
'
'   locate_selectElementsToModify - solicits user for elements to
'           modify and manipulates them.
'
'---------------------------------------------------------------
Sub locate_selectElementsToModify()
    Dim elem            As Object
    Dim filePos         As Long
    Dim point           As Object
    Dim acceptPoint As Object
    Dim acceptScreenPt  As Object
    Dim firstScreenPt   As Object
    Dim MbeState    As Object
    Dim stat            As Integer
    Dim view            As Integer
    Dim acceptView  As Integer
    Dim continueLocate  As Integer
    Dim haveAcceptPoint As Integer

    continueLocate = False
    haveAcceptPoint = False

    Set point = msApp.MbePoint
    Set acceptPoint = msApp.MbePoint
    Set acceptScreenPt = msApp.MbePoint
    Set firstScreenPt = msApp.MbePoint
    Set elem = msApp.MbeElement
    Set MbeState = msApp.MbeState

    Do
    ' Display messages
    Call locate_displayPrompts

    ' Start locating an element, don't put out msgs,
    ' don't hilite when found, don't allow components,
    ' continue locate from previous element if appropriate.
    msApp.MbeStartLocate 0, 0, 0, continueLocate

    ' If accepted element or continuing from a reset
    ' send the previously entered point.
    If haveAcceptPoint Or continueLocate Then
        Call msApp.MbeSendDataPoint(acceptPoint, acceptView)
        continueLocate = False

        ' If previous element accepted, future comparisons are to accept point
        If haveAcceptPoint Then
            haveAcceptPoint = False
        point.x = acceptPoint.x: point.y = acceptPoint.y: point.z = acceptPoint.z
        view = acceptView
        firstScreenPt.x = acceptScreenPt.x
        firstScreenPt.y = acceptScreenPt.y
        firstScreenPt.z = acceptScreenPt.z
        End If
    Else
        ' Wait for a data point or a reset
        msApp.MbeGetInput msApp.MBE_DataPointInput, msApp.MBE_ResetInput

        ' If user resets, exit the loop.
        If MbeState.inputType = msApp.MBE_ResetInput Then
        Exit Do

        ' On a data point, retrieve the point for future use, then
        '   send it through to be processed.
        ElseIf MbeState.inputType = msApp.MBE_DataPointInput Then
            stat = MbeState.getInputDataPoint(point, view, firstScreenPt)
        msApp.MbeSendLastInput
        End If
    End If

    ' If we found an element, check for acceptability
    If MbeState.cmdResult = msApp.MBE_AcceptQuery Then
        ' if we did not find a line, keep resetting until
        '    either we find one or we run out of candidates
        Do
        filePos = elem.fromLocate()
        If locate_isElementAcceptable(elem) Then

            ' located an acceptable element - hilite it
            elem.display msApp.MBE_Hilite

            ' prompt the user to accept or reject it
            msApp.MbeWritePrompt "Accept / Reject"

            ' get data to accept, reset to reject
            msApp.MbeGetInput msApp.MBE_DataPointInput, msApp.MBE_ResetInput

            If MbeState.inputType = msApp.MBE_DataPointInput Then
                ' on Data point, accept element and modify it
            stat = MbeState.getInputDataPoint(acceptPoint, _
                            acceptView, acceptScreenPt)
            Call locate_manipulateElement(point, view)

            ' continue locating if accept point near first point
            continueLocate = locate_pointsCloseEnough(acceptScreenPt, _
                                   firstScreenPt)
            haveAcceptPoint = True
            Else
            ' user rejected it - continue looking around the same point
            ' by continuing the locate operation in the loop.
            elem.display msApp.MBE_NormalDraw
            acceptPoint = point
            acceptView = view
            continueLocate = True
            End If
            Exit Do
        Else
            ' found an element but it is not acceptable to our filter.
            ' Send resets to the locate logic to cause it to retrieve
            ' the next closest element in range
            msApp.MbeSendReset
            If MbeState.cmdResult = msApp.MBE_ElementNotFound Then
            Call locate_elementUnacceptable
            Exit Do
            End If
        End If
        Loop While elem.type <> msApp.MBE_Line
    ElseIf MbeState.cmdResult = msApp.MBE_ElementNotFound Then
        msApp.MbeWriteError "Element Not Found"
    Else
        Debug.Print "unexpected MbeState.cmdResult of "; MbeState.cmdResult
    End If
    Loop

End Sub

'---------------------------------------------------------------
'
'   LocateEntry - entry point for locate test program
'
'---------------------------------------------------------------
Sub LocateTest()
    Dim saveColor       As Integer
    Dim saveWeight  As Integer
    Dim saveMsgs        As Integer
    Dim elemSet     As Object
    Dim MbeSettings As Object
    Dim MbeState    As Object

    Set elemSet = msApp.MbeElementSet
    Set MbeSettings = msApp.MbeSettings
    Set MbeState = msApp.MbeState

    ' set up for manipulation by saving the old settings and setting new ones
    saveColor = MbeSettings.color
    saveWeight = MbeSettings.weight
    saveMsgs = MbeState.messages

    ' set MicroStation to a neutral state
    msApp.MbeSendCommand "NULL"

    ' get rid of any selection set
    If elemSet.fromSelectionSet(1) = msApp.MBE_Success Then
        elemSet.Clear
    End If

    MbeSettings.color = 3
    MbeSettings.weight = 3
    MbeState.messages = 0

    locate_selectElementsToModify

    msApp.MbeWriteStatus "Leaving locate function"

    ' Clear the messages
    MbeSettings.color = saveColor
    MbeSettings.weight = saveColor
    MbeState.messages = saveMsgs

    msApp.MbeWritePrompt
    msApp.MbeWriteCommand
End Sub