Chip 1997 January/Chip_1997-01_cd.bin/ms95/disk22/dir04/f010540.re_/f010540.re

Text File | 1996-04-02 | 8KB | 217 lines

' Cell Replacement Example

    Private gGravelCell                 As MbeElement

'-------------------------------------------------------------
'
'   Shows a rotation matrix.  Useful for debugging.
'
'-------------------------------------------------------------
Sub ShowRotation (indent as Integer, inElem as MbeElement)
    dim iRow as Integer
    dim iCol as Integer
    dim rotMatrix(1 To 3,1 To 3) as Double
    dim myAngle as double

    If inElem.getRotation (rotMatrix) = MBE_Success Then
        print Spc(indent);"Rotation :";
        For iRow = 1 To 3
            For iCol = 1 To 3
                print "  ";rotMatrix(iRow,iCol);
            Next iCol
            print
            If IRow < 3 Then print Spc(indent);"         :";
        Next iRow
    End If

End Sub

'------------------------------------------------------------------
'
'   Inverts a rotation matrix
'
'------------------------------------------------------------------
Sub invertRMatrix (outRMatrix() As Double, inRMatrix() As Double)

    Dim i                           As Integer
    Dim j                           As Integer
    Dim tRMatrix(1 To 3,1 To 3)     As Double

    ' Make copy since inRMatrix and outRMatrix can be the same Matrix
    For i = 1 To 3
        For j = 1 To 3
            tRMatrix(i, j) = inRMatrix(i, j)
        Next j
    Next i

    ' Invert the matrix
    For i = 1 To 3
        For j = 1 To 3
            outRMatrix(j, i) = tRMatrix(i, j)
        Next j
    Next i

End Sub

'------------------------------------------------------------------
'
'   Takes the cell passed in, copies it, and rotates the components
'   of the cell into cell coordinate space.  This step saves us from
'   having to do this rotation each time we use the cell to substitute
'   for another cell.
'
'------------------------------------------------------------------
Function prepareReplacementCell (cellElem As MbeElement) As MbeElement

    Dim origin                          As MbePoint
    Dim rMatrix(1 To 3,1 To 3)          As Double
    Dim statI                           As Integer
    Dim statL                           As Long
    Dim newCell                         As New MbeElement

'   Make a copy of the cell passed in.
    statL = newCell.fromElement (cellElem)

    statI = newCell.getOrigin(origin)

'   Unrotate the cell back to it's coordinate space now.  This way, we
'   won't have to do this each time we use the cell to replace another cell.

    If newCell.getRotation (rMatrix) = MBE_Success Then
        invertRMatrix rMatrix, rMatrix
        statI = newCell.rotate(rMatrix, origin)
    End If

    Set prepareReplacementCell = newCell

End Function

'------------------------------------------------------------------
'
'   In the plot, the cell "oldCell" is replaced with "repCell".
'   Disproportionate scaling is used so that "repCell" fills the
'   same area on the plot as the original cell.
'
'------------------------------------------------------------------
Sub replaceAndFitCell (oldCell As MbeElement, repCell As MbeElement)

    Dim statI                           As Integer
    Dim statL                           As Long
    Dim newCell                         As MbeElement
    Dim oldRange                        As MbeRange
    Dim newRange                        As MbeRange
    Dim oldOrigin                       As MbePoint
    Dim newOrigin                       As MbePoint
    Dim xScale                          As Double
    Dim yScale                          As Double
    Dim zScale                          As Double
    Dim moveDistance                    As MbePoint
    Dim oldRMatrix(1 To 3,1 To 3)       As Double
    Dim invOldRMatrix(1 To 3,1 To 3)    As Double
    Dim boxPoints()                     As MbePoint

'   Make a copy of the cell that we're going to use to replace 'inElem'
    Set newCell = New MbeElement
    statL = newCell.fromElement (repCell)

    statI = oldCell.getOrigin(oldOrigin)
    statI = newCell.getOrigin(newOrigin)

'   Unrotate the cell back to it's coordinate space.  Note that this was already
'   done in prepareReplacementCell() for newCell.
    If oldCell.getRotation (oldRMatrix) = MBE_Success Then
        invertRMatrix invOldRMatrix, oldRMatrix
        statI = oldCell.rotate(invOldRMatrix, oldOrigin)
    End If

'   Calculate X, Y and Z scale factors
    statI = oldCell.getCellBox(boxPoints)
    oldRange.xLow = boxPoints(1).x
    oldRange.yLow = boxPoints(1).y
    oldRange.zLow = boxPoints(1).z
    oldRange.xHigh = boxPoints(3).x
    oldRange.yHigh = boxPoints(3).y
    oldRange.zHigh = boxPoints(3).z

    statI = newCell.getCellBox(boxPoints)
    newRange.xLow = boxPoints(1).x
    newRange.yLow = boxPoints(1).y
    newRange.zLow = boxPoints(1).z
    newRange.xHigh = boxPoints(3).x
    newRange.yHigh = boxPoints(3).y
    newRange.zHigh = boxPoints(3).z

    xScale    = (oldRange.xHigh - oldRange.xLow) / (newRange.xHigh - newRange.xLow)
    yScale    = (oldRange.yHigh - oldRange.yLow) / (newRange.yHigh - newRange.yLow)
    zScale    = (oldRange.zHigh - oldRange.zLow) / (newRange.zHigh - newRange.zLow)

'   Apply disproportionate scaling
    statI = newCell.scale (xScale, yScale, zScale, newOrigin)

'   Move the origin of the replacement to the origin of the cell to be replaced.
    moveDistance.x = oldOrigin.x - newOrigin.x
    moveDistance.y = oldOrigin.y - newOrigin.y
    moveDistance.z = oldOrigin.z - newOrigin.z
    statI = newCell.move (moveDistance)
    statI = newCell.getOrigin(newOrigin)

'   Rotate the replacement cell the same way the cell to be replaced is rotated.
    statI = newCell.rotate(oldRMatrix, newOrigin)

'   Replace the cell
    statL = oldCell.fromElement (newCell)

End Sub

'-------------------------------------------------------------
'
'   This function is called from the section named 'cellsub_gravel'
'   in the pen table named 'cellsub.tbl'.  The pen table
'   selection criteria ensures that only cells and sharedcells
'   are passed to this function.
'
'-------------------------------------------------------------
Function cellsub_gravel (inElem as MbeElement) As Long

    Dim cellName$       As String

    cellsub_gravel = MBE_ElemNormal

    cellName$ = inElem.cellName
    If cellName$ = "A" Or cellName$ = ".Z" Or cellName$ = "SPGRID" Or cellName$ = "INOUT4" Or cellName$ = "CONSHK" Then
        If gGravelCell is not Nothing Then
            replaceAndFitCell inElem, gGravelCell
        End If
    End If

End Function

'-------------------------------------------------------------
'
'   Find the cell named GRAVEL in the master file.  Later,
'   we will replace certain other cells with this cell in
'   our plots.
'
'-------------------------------------------------------------
Sub main
    dim elem as New MbeElement
    dim filePos as long

    MbeCurrentTransform.MasterUnits

    filePos = 768*2
    Do
        filePos = elem.fromFile (filePos)
        If filePos > 0 Then
            filePos = filePos + elem.fileSize
            If elem.type = MBE_SharedCell Or elem.type = MBE_CellHeader Then
                If gGravelCell is Nothing And elem.cellName = "GRAVEL" Then
                    Set gGravelCell = prepareReplacementCell (elem)
                    Exit Do
                End If
            End If
        End If
    Loop While filePos > 0

End Sub