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 ExplicitImplements IPrimitiveCommandEventsPrivate m_strCellName As StringPublic Property Let cellName(ByVal name As String) m_strCellName = nameEnd PropertyPublic Property Get cellName() As String cellName = m_strCellNameEnd PropertyPrivate Sub IPrimitiveCommandEvents_Cleanup()End SubPrivate 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 SubPrivate Sub IPrimitiveCommandEvents_DataPoint(Point As Point3d, ByVal view As view) CreateCell Point, msdDrawingModeNormalEnd SubPrivate Sub IPrimitiveCommandEvents_Dynamics(Point As Point3d, ByVal view As view, ByVal DrawMode As MsdDrawingMode) Call DeleteOldCell Call DistanceFromBegin(Point) CreateCell Point, DrawModeEnd SubPrivate Sub IPrimitiveCommandEvents_Keyin(ByVal Keyin As String)' m_strCellName = KeyinEnd SubPrivate Sub IPrimitiveCommandEvents_Reset() CommandState.StartDefaultCommandEnd SubPrivate Sub IPrimitiveCommandEvents_Start() CommandState.CommandName = "TerraCarta" ShowCommand CommandState.CommandName ShowPrompt "Plaats type" CommandState.StartDynamics 'CommandState.EnableAccuSnapEnd SubSub DistanceFromBegin(Punt As Point3d)Dim ee As ElementEnumerator, esc As New ElementScanCriteriaDim RadarLijn As LineElement, RadarGramAfstandsPoint As Point3d, Cirkel As EllipseElementesc.ExcludeAllLevelsesc.ExcludeAllTypesesc.IncludeLevel ActiveDesignFile.Levels("RadarGram")esc.IncludeType msdElementTypeLineSet 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 SubSub AfstandOpMeetlijn(Afstand As Double)Dim ee1 As ElementEnumerator, esc1 As New ElementScanCriteriaDim Meetlijn As LineElement, PuntOpMeetlijn As Point3d, HulpPunt As CellElementDim Ellips As EllipseElement, Flags As MsdTransientFlagsesc1.ExcludeAllLevelsesc1.ExcludeAllTypesesc1.IncludeLevel ActiveDesignFile.Levels("Meetlijn")esc1.IncludeType msdElementTypeLineSet 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 WendEnd SubSub DeleteOldCell()Dim ee As ElementEnumerator, esc As New ElementScanCriteriaesc.ExcludeAllLevelsesc.ExcludeAllTypesesc.IncludeLevel ActiveDesignFile.Levels("Hulppunt")esc.IncludeType msdElementTypeCellHeaderSet ee = ActiveDesignFile.Models("Model").Scan(esc)While ee.MoveNext ActiveDesignFile.Models("Model").RemoveElement ee.CurrentWendActiveDesignFile.Models("Model").UnselectAllElementsEnd Sub
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
Bentley Accredited Developer: iTwin Platform - AssociateLabyrinth Technology | dev.notes() | cad.point
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.
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):
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
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!