2 models, temporary visible of the mouse position, vba

Hi all,

I have 2 models in the same dgn. 1 model is for a rasterfile ("Radargrammen") and the other for the overview ("Model"). In the model Radargrammen i hover with my mouse over the raster and i am able to calculate a distance from teh beginning of the raster. At the same time i want to show where on the line in the model "Model" i hover with my mouse. In attached code it is possible, but it seems to be impossible to add a cell  temporary. So i add it to the model, and when i move the mouse then i delete the old cell. It seems that this works good, but in model "Model" the old cell does not disappear immidiately. Does anyone have a solution?

Sorry for my bad english.....;=)

Regards, Aart

Option Explicit

Implements IPrimitiveCommandEvents
Private m_strCellName   As String

Public Property Let cellName(ByVal name As String)
    m_strCellName = name
End Property

Public Property Get cellName() As String
    cellName = m_strCellName
End Property

Private Sub IPrimitiveCommandEvents_Cleanup()
End Sub

Private Sub CreateCell(ByRef Point As Point3d, ByVal DrawMode As MsdDrawingMode)
    
    Dim i As Long
    Dim oCell As CellElement

    Set oCell = CreateCellElement2(m_strCellName, Point, Point3dOne, True, Matrix3dIdentity)
    If DrawMode = msdDrawingModeNormal Then
        ActiveModelReference.AddElement oCell
    Else
        oCell.Redraw DrawMode
    End If
    
End Sub

Private Sub IPrimitiveCommandEvents_DataPoint(Point As Point3d, ByVal view As view)

    CreateCell Point, msdDrawingModeNormal

End Sub

Private Sub IPrimitiveCommandEvents_Dynamics(Point As Point3d, ByVal view As view, ByVal DrawMode As MsdDrawingMode)
    
    Call DeleteOldCell
    Call DistanceFromBegin(Point)
    CreateCell Point, DrawMode

End Sub

Private Sub IPrimitiveCommandEvents_Keyin(ByVal Keyin As String)

'    m_strCellName = Keyin

End Sub

Private Sub IPrimitiveCommandEvents_Reset()
    
    CommandState.StartDefaultCommand

End Sub

Private Sub IPrimitiveCommandEvents_Start()
    
    CommandState.CommandName = "TerraCarta"
    ShowCommand CommandState.CommandName
    ShowPrompt "Plaats type"
    CommandState.StartDynamics
    'CommandState.EnableAccuSnap

End Sub

Sub DistanceFromBegin(Punt As Point3d)

Dim ee As ElementEnumerator, esc As New ElementScanCriteria
Dim RadarLijn As LineElement, RadarGramAfstandsPoint As Point3d, Cirkel As EllipseElement

esc.ExcludeAllLevels
esc.ExcludeAllTypes
esc.IncludeLevel ActiveDesignFile.Levels("RadarGram")
esc.IncludeType msdElementTypeLine

Set ee = ActiveModelReference.Scan(esc)

While ee.MoveNext
    Set RadarLijn = ee.Current
    
    RadarGramAfstandsPoint = RadarLijn.ProjectPointOnPerpendicular(Punt, Matrix3dIdentity)
 
    Call AfstandOpMeetlijn(RadarGramAfstandsPoint.X)
 
'    Set Cirkel = CreateEllipseElement2(Nothing, RadarGramAfstandsPoint, 1, 1, Matrix3dIdentity)
'    Cirkel.Redraw msdDrawingModeTemporary
    
Wend
    
End Sub

Sub AfstandOpMeetlijn(Afstand As Double)

Dim ee1 As ElementEnumerator, esc1 As New ElementScanCriteria
Dim Meetlijn As LineElement, PuntOpMeetlijn As Point3d, HulpPunt As CellElement
Dim Ellips As EllipseElement, Flags As MsdTransientFlags

esc1.ExcludeAllLevels
esc1.ExcludeAllTypes
esc1.IncludeLevel ActiveDesignFile.Levels("Meetlijn")
esc1.IncludeType msdElementTypeLine

Set ee1 = ActiveDesignFile.Models("Model").Scan(esc1)

While ee1.MoveNext
    Set Meetlijn = ee1.Current
    TijdelijkPunt = Meetlijn.PointAtDistance(Afstand)
    Set HulpPunt = CreateCellElement3("Hulppunt", TijdelijkPunt, True)
    ActiveDesignFile.Models("Model").AddElement HulpPunt '' > I have to,  ;-(
    HulpPunt.Redraw msdDrawingModeTemporary
      
Wend

End Sub

Sub DeleteOldCell()

Dim ee As ElementEnumerator, esc As New ElementScanCriteria

esc.ExcludeAllLevels
esc.ExcludeAllTypes
esc.IncludeLevel ActiveDesignFile.Levels("Hulppunt")
esc.IncludeType msdElementTypeCellHeader

Set ee = ActiveDesignFile.Models("Model").Scan(esc)

While ee.MoveNext
    ActiveDesignFile.Models("Model").RemoveElement ee.Current
Wend
ActiveDesignFile.Models("Model").UnselectAllElements

End Sub


Parents
  • Hi Aart,

    as Jon wrote, it's important to always mention product you use including its build number, because despite of the forum is named as "MicroStation Programming", sometimes a programming topics related to MicroStation-based products are discussed there also.

    Please use Insert code tool to place any code snippet. Unfortunately there is no VBA highlighter available, but even a plain not colorized code is far better than normal text ... which is completely unreadable.

    Unknown said:
    I have 2 models in the same dgn.

    Can you share an example? Right now I am not sure whther it has any influence to a code, but it's always better to know with what data and file structure the code will work with.

    Unknown said:
    but it seems to be impossible to add a cell  temporary.

    What does it mean? What code did you use and what was the result? Any error message?

    Unknown said:
    So i add it to the model, and when i move the mouse then i delete the old cell.

    Please, don't even think about such solution! It's really bad with some serious impacts. To draw temporary element in Dynamic method is the only correct solution.

    With regards,

      Jan

  • Hi Jan

    Thanks for your time.

    Unknown said:
    Can you share an example?

    When i tried to attach a dgn an error raised, so i have attached a screenvideo...

    Unknown said:
    What does it mean? What code did you use and what was the result? Any error message?

    The reason to add that cell temporarily is to show where my mouse is. I Attach a screenmovie to show what i mean.

    Unknown said:
    Please, don't even think about such solution! It's really bad with some serious impacts. To draw temporary element in Dynamic method is the only correct solution.

    Yes, that was also my opinion, but when i tried to draw in the Dynamic method, nothing happen.

    Regards, Aart

  • Hi Aart,

    Unknown said:
    In attached code

    I copied your code into editor, so I was able to read it a bit easier. Honestly, the code is not very good, I recommend (at least):

    • Don't put everything (all functionality) in one class. This is one of the most often bad practices I see in (not only) VBA code. A general rule for plenty of programming languages is "One 'unit' has to do one thing.", but in your case class responsible for handling of primitive command events also creates cell, scans model ... not good.
    • Explicitely define when a method or function is public or private.
    • Use English names, not local (Dutch I guess in this case) language. It helps when you need to discuss/share your code with other people. Local function names makes always the code unreadable.

    Unknown said:
    but when i tried to draw in the Dynamic method, nothing happen

    This code work fine:

    Option Explicit
    
    Implements IPrimitiveCommandEvents
    
    Const cellName As String = "Hulppunt"
    Dim cellForDynamic As CellElement
    Dim displayCell As Boolean
    
    Private Sub IPrimitiveCommandEvents_Cleanup()
    
    End Sub
    
    Private Sub IPrimitiveCommandEvents_DataPoint(Point As Point3d, ByVal View As View)
        If displayCell = False Then
            displayCell = True
            CommandState.StartDynamics
        Else
            displayCell = False
            CommandState.StopDynamics
        End If
        
    End Sub
    
    Private Sub IPrimitiveCommandEvents_Dynamics(Point As Point3d, ByVal View As View, ByVal DrawMode As MsdDrawingMode)
        Dim tempCell As CellElement
        Set tempCell = cellForDynamic.Clone
        tempCell.Move Point
        tempCell.Redraw DrawMode
    End Sub
    
    Private Sub IPrimitiveCommandEvents_Keyin(ByVal Keyin As String)
    
    End Sub
    
    Private Sub IPrimitiveCommandEvents_Reset()
    
    End Sub
    
    Private Sub IPrimitiveCommandEvents_Start()
        ShowTempMessage msdStatusBarAreaMiddle, ""
        ShowCommand "Place in dynamics"
        Set cellForDynamic = CreateCellForDynamic
        displayCell = False
    End Sub
    
    Private Function CreateCellForDynamic() As CellElement
        On Error GoTo ErrHandler
        Set CreateCellForDynamic = CreateCellElement3(cellName, Point3dZero(), False)
        Exit Function
    ErrHandler:
        MessageCenter.AddMessage _
            "Primitive command not initialized properly", _
            "It was not possible to create a cell for dynamic.", _
            msdMessageCenterPriorityError, False
        CommandState.StartDefaultCommand
    End Function
    

    With regards,

      Jan

    Answer Verified By: GeoNext 

  • Hi Jan,

    You pointed me the right direction so my problem has been solved. Thanks for your time and your suggestions!

    Regards, Aart

Reply Children
No Data