Fill in Data fields in design file

Hi Leo,

similarly to Jon I have also a few comments.

Leo van der Hoeven said:

Complete function is :

Honestly, in my opinion the function is badly written. When I reformat it to something that makes more sense to me and add comments:

Public Function WelkeID() As String
    'On Error GoTo Foutje                           ' Error is generated here only when code is wrong, so why to use OnError?
    
    Dim idProjectnummer As DLong
    idProjectnummer = DLongFromString("25428")      ' Why id created from string?
                                                    ' Do you know the element with ID 25428 exists?
    
    Dim Pos As ModelReference
    Set Pos = ActiveDesignFile.Models("Default")    ' Are you sure a mode "Default" exists?
    
    Dim ele As TextElement
    Set ele = Pos.GetElementByID(idProjectnummer)   ' How you can know that element is text?
    
    WelkeID = "Nieuw"
Exit Function

But it still does not answer my main question: What is an intention of the function? To find whether element id 25428 exists in default model?

Leo van der Hoeven said:

but gives me a type mismatch on Connect, on this line :

It's why I asked in the code above whether you are sure the element exists and when it exists, that it's text.

Both ideas are wrong in my case: Element should never be identified explicitly by its id (something else is to obtain id dynamically using e.g. scanning) and without further test code, it's risky to expect element type (assign element o TextElement variable).

Leo van der Hoeven said:

Is this way of programming no longer valid in Microstation Connect?

My experience and how VBA API was migrated to CE is similar to what Jon wrote: Typically VBA code runs without modifications. But I would like to change it to that typically good VBA code runs fine. Problems appears often when code written incorrectly, running fine in V8, is ported to CE, because something tiny has changed in API or inside MicroStation engine.

With regards,

  Jan

Hi Jan and Jon,

I' m quite aware of the possibility the code is written a bit poorly, but I can't take the credit for that, since it's made by one of my predecessors for op to 15 years ago. But al that time it worked.

When I go through the code it code it does seems overly complicated,  so I do plan to optimize the code, but for now my priority is to get it working.

I'll try to explain what the code does, or should do.

This code is used to create a new drawing file from a seed file.

The seed file contains two models, one is Default, the other DefaultPosities. We have an Userform for the user to enter the text that has to go in the Title block.  which is Projectnumber (idProjectnummer) project name , client name and Calculation Number, User and date, when a Project is started.User fills in project number, name, client name, and calculation number, in a textbox of the userform, after a button press there are subs that check if file already exists and such.

Then the code arrived at the above part. This part should check if we are dealing with a New project ( "Nieuw" ), Which is when "25428"is found,  or an existing ( "Oud" ) When "25428"isn't found.

When it's a new one Variable "WelkeID" is set to NEW. when not new to old. I have no Idea why this is done with an error, and also find this rather sloppy.

Project always contains one or more positions, which have a Name and position number. These are filled in on another userform, and stored in model DefaultPosities. But this is al done further along in the code.

When I comment out the line " Set ele = Pos.GetElementByID(idProjectnummer) " I get the same error in the next sub, where the actual data should be entered to the title block

I put a watch on the "idprojectnummer", see screenshot:

I checked the ID numbers, they are all existing and correct, Model Default exists, and there is only text to insert.

The sub the error is in now:

Public Sub WijzigDefaultTitelbalk()
Dim ele As TextElement
Dim idProjectnummer As DLong
Dim idCalculatienummer As DLong
Dim idOpdrachtgever As DLong
Dim idProject As DLong
Dim model As ModelReference

Set model = ActiveDesignFile.Models("Default")

If WelkeID() = "Nieuw" Then
    idProjectnummer = DLongFromString("25428")
    idCalculatienummer = DLongFromString("25429")
    idOpdrachtgever = DLongFromString("25425")
    idProject = DLongFromString("25424")
    idBenaming = DLongFromString("25401")
    idPositienummer = DLongFromString("25430")
Else
    idOpdrachtgever = DLongFromString("325105")
    idBenaming = DLongFromString("325104")
    idProject = DLongFromString("325103")
    idProjectnummer = DLongFromString("325106")
    idCalculatienummer = DLongFromString("325107")
    idPositienummer = DLongFromString("325100")
End If


If frmNieuwProject.txtProject.TextLength >= 9 Then
    If frmNieuwProject.txtCalculatie.TextLength = 10 Then 'was 9 140225
        Set ele = model.GetElementByID(idProjectnummer)
        ele.IsLocked = False
        ele.Text = frmNieuwProject.txtProject.Value
        ele.Rewrite
        ele.IsLocked = True
        Set ele = Nothing
                    
        Set ele = model.GetElementByID(idCalculatienummer)
        ele.IsLocked = False
        ele.Text = frmNieuwProject.txtCalculatie.Value
        ele.Rewrite
        ele.IsLocked = True
        Set ele = Nothing

        Set ele = model.GetElementByID(idOpdrachtgever)
        ele.IsLocked = False
        ele.Text = frmNieuwProject.txtOpdrachtgever.Value
        ele.Rewrite
        ele.IsLocked = True
        Set ele = Nothing

        Set ele = model.GetElementByID(idProject)
        ele.IsLocked = False
        ele.Text = frmNieuwProject.txtOmschrijving.Value
        ele.Rewrite
        ele.IsLocked = True
        Set ele = Nothing
    End If
End If

End Sub

the error now is on Line 30. So what can this be?

Thanks Leo

Leo van der Hoeven said:

Unfortunately since we have thousands of old files which wouldn't work anymore I can't really change the code so the old files wouldn't work.

That is an awkward situation I saw several times, when not good original decision creates heritage that is not simple to solve :-(

I think it should be treated as a kind of warning that this issue exist, because using fixed hard-coded IDs does not allow to change anything.

Leo van der Hoeven said:

I will have to change all the places where this is used

I agree with Jon to follow DRY practice is crucial. Ideally (which never happen ;-), any functionality, represented in the code, should exist once only.

This is a disadvantage of VBA that it's missing advanced refactoring tools, so any analysis and consequent optimization and refactoring is time consuming risky task (whereas in editors like Visual Studio or Visual Studio Code, with many specialized extensions available, it's simple and faster).

Regards,

  Jan

Leo van der Hoeven said:

You mentioned you already posted the function

Search for GetTextElementById in this thread.

Sorry Jon,

I did see that function, but it came in before the workaround from Artur so I didn't realize it was the same. 

I did try it but it gave me a syntax error on the line:

Set oRaw = oModel.GetElementById (DLongFromString elementId)

I'am trying to fix this but so far lo luck

Thanks,

Leo

Leo van der Hoeven said:

t gave me a syntax error

Oops!

Set oRaw = oModel.GetElementById (DLongFromString (elementId))

Hi Jon,

Now I get a compile error on this line on idProjectnummer

If DLongToString(oComponents.Current.ID) = DLongToString(idProjectnummer) Then

So I figured the line should be:

 If DLongToString(oComponents.Current.id) = (DLongToString(elementId)) Then

But this give me the same error,

Both are:  ByRef argument type mismatch

Leo van der Hoeven said:

Now I get a compile error

If DLongToString(oComponents.Current.ID) = elementId Then

Hi Jon,

I was just trying what you suggested. Code runs after this, so that's nice, only the If statement never becomes through.

I stepped through the code, and put a watch on oComponents.Current.id.

There are only 2 loops, and then I get the messagebox with failed because the element is not a TextElement.

Component.id numbers that are found are 29565 and 25400. These are both the top level ID numbers from two of the cells from the seed. All other ID numbers are not found.

Leo van der Hoeven said:

Code runs... Component.id numbers that are found are 29565 and 25400

It's hard for us to guess what's going on...

1. We can't see your current code
2. We don't have your DGN file

If you want more help, you must supply evidence!

Hi jon,

Sorry for that, I'll be more precise.

The function I have now is:

Function GetTextElementById(ByVal oModel As ModelReference, ByVal elementId As String) As TextElement
 
  Set GetTextElementById = Nothing
    Dim oRaw As Element
        Set oRaw = oModel.GetElementByID(DLongFromString(elementId))
        Debug.Assert Not oRaw Is Nothing
        Dim oFound As TextElement
                If oRaw.IsTextElement Then
                Set oFound = oRaw.AsTextElement
                Debug.Print "Element [" & elementId & "] content '" & oFound.Text & "'"
                
        ElseIf oRaw.IsCellElement Then
                Dim oComponents As ElementEnumerator
                Set oComponents = oRaw.AsCellElement.GetSubElements
        Do While oComponents.MoveNext
        Debug.Print "oComponents is element type " & DLongToString(oComponents.Current.id)
                If DLongToString(oComponents.Current.id) = elementId Then
                        If oComponents.Current.IsTextElement Then
                        Set oFound = oComponents.Current.AsTextElement
                                Exit Do
                        End If
                End If
        Loop
  End If
 
  If oFound Is Nothing Then
        Dim msg As String
        msg = "GetTextElementById(" & elementId & ") failed because the element is not a TextElement"
        ShowMessage msg, msg, msdMessageCenterPriorityWarning, True
  Else
        Set GetTextElementById = oFound
  End If
End Function

This is called by:

        Dim oText As TextElement
        Dim idProject_nummer As String
        idProject_nummer = 25428
        Set oText = GetTextElementById(ActiveModelReference, idProject_nummer)

The element number I get back are from the blue line in the picture, and the one above it:

If it's helpful here is the seed file,

A3seed-SRP.dgn

I will try to be complete from now on,

Thanks,

Leo

Your screenshot shows the problem: you have nested cells.  Artur's workaround looks only one level into the cell, because he didn't have all the information when he wrote that code.

Top-level cell has no name, second-level cell is A3Syntess, and the TextElements are in that cell.  Your function needs to dig down two levels to find the text elements.

The following VBA script should do what you want.  It looks recursively into cells to examine text elements...

FindTextInCell.zip

The code is a VBA model exported from my VBA project to a *.bas file.  To use it, open a VBA project and use the IDE Import menu to create a new module from that *.bas file.  If it works, you can copy the FindText function to your own project.

I've tested it successfully with stand-alone text, text in a top-level cell, and text in a nested cell like yours.

Your screenshot shows the problem: you have nested cells.  Artur's workaround looks only one level into the cell, because he didn't have all the information when he wrote that code.

Top-level cell has no name, second-level cell is A3Syntess, and the TextElements are in that cell.  Your function needs to dig down two levels to find the text elements.

The following VBA script should do what you want.  It looks recursively into cells to examine text elements...

FindTextInCell.zip

The code is a VBA model exported from my VBA project to a *.bas file.  To use it, open a VBA project and use the IDE Import menu to create a new module from that *.bas file.  If it works, you can copy the FindText function to your own project.

I've tested it successfully with stand-alone text, text in a top-level cell, and text in a nested cell like yours.

Hi Jon,

Thanks for the zip file. That was very helpful. I borrowed two functions from it and inserted them in my code, *** now runs nicely to insert the text at the locations in the dgn.file so I went on whit the next step.

Further on in the code I need to reed back the same values I put in the dgn to make the next model. This uses the same project numbers and calculation numbers and such, as the first model, so I figured I use the same Functions I use to put the text in the model.

The functions I have now are:

Function FindTextID(ByVal oModel As ModelReference, ByRef textId As DLong, ByRef TextString As String) As TextElement
    Set FindText = Nothing
    Dim oRaw                                As Element
    '   Because of bug in CONNECT, this gets the top-level cell
    Set oRaw = oModel.GetElementByID(textId)
    Debug.Print "Found element type " & oRaw.Type & " ID=" & DLongToString(oRaw.id)
    If oRaw.IsTextElement Then
        If 0 = DLongComp(textId, oRaw.id) Then
            Set FindText = oRaw
            Exit Function
        End If
    ElseIf oRaw.IsCellElement Then
        Set FindText = FindTextInCell(oRaw.AsCellElement, textId, TextString)
        Debug.Print "FindText"
    Else
    End If
End Function
'   FindTextInCell
'   Recursive function digs into a pile of cells to find given text.
' ---------------------------------------------------------------------
Function FindTextInCell(ByVal oCell As CellElement, ByRef textId As DLong, ByRef TextString As String) As TextElement
    Set FindTextInCell = Nothing
    Dim oComponents                     As ElementEnumerator
    Set oComponents = oCell.GetSubElements
    Dim TextToSet As TextElement
        Do While oComponents.MoveNext
        If oComponents.Current.IsTextElement Then
        Debug.Print "oComponents text is :" & DLongToString(oComponents.Current.id)
        If DLongToString(oComponents.Current.id) = DLongToString(textId) Then
                Debug.Print " text found by function"
                
                Set TextToSet = oComponents.Current
                TextToSet.IsLocked = False
                TextToSet.Text = TextString
                TextToSet.Rewrite
                TextToSet.IsLocked = True
                Set TextToSet = Nothing
                Set FindTextInCell = oComponents.Current
                Exit Function
        End If
            If 0 = DLongComp(textId, oComponents.Current.id) Then
                Set FindTextInCell = oComponents.Current.AsTextElement
                Exit Function
            End If
        ElseIf oComponents.Current.IsCellElement Then
        Debug.Print "oComponents is :" & DLongToString(oComponents.Current.id)
            Set FindTextInCell = FindTextInCell(oComponents.Current.AsCellElement, textId, TextString)
        End If
    Loop
End Function

Mostly the code from the zipfile. I added an If statement trigger, to write the text in the dgn, when the right ID number is found.

Ending with the lines: Set FindTextInCell = oComponents.Current
                                   Exit Function

I thought that, since a function can return a value this should end the function and return the value to FindTextID Function, from where I could send it on to the sub that called on the functions.

I see the FindTextInCell value change in the watchwindow , but the exit Function doesn't do anything, and FindTextInCell keeps running, then after a few itterations of the while block the value of FindTextInCell turns to out of context.

I let the code run to the breakpoint on line Debug.Print "FindText". At that time there is no value in Findtext or FindtextID.

When I want to write to the dgn I use :

Public Sub WijzigDefaultTitelbalk()
Dim ele As TextElement
Dim idProjectnummer As DLong
Dim idCalculatienummer As DLong
Dim idOpdrachtgever As DLong
Dim idProject As DLong
Dim model As ModelReference

Set model = ActiveDesignFile.Models("Default")

If WelkeID() = "Nieuw" Then
    idProjectnummer = DLongFromString("25428")
    idCalculatienummer = DLongFromString("25429")
    idOpdrachtgever = DLongFromString("25425")
    idProject = DLongFromString("25424")
    idBenaming = DLongFromString("25401")
    idPositienummer = DLongFromString("25430")
Else
    idOpdrachtgever = DLongFromString("325105")
    idBenaming = DLongFromString("325104")
    idProject = DLongFromString("325103")
    idProjectnummer = DLongFromString("325106")
    idCalculatienummer = DLongFromString("325107")
    idPositienummer = DLongFromString("325100")
End If



If frmNieuwProject.txtProject.TextLength >= 9 Then
    If frmNieuwProject.txtCalculatie.TextLength = 10 Then 'was 9 140225
    
        Dim oText As TextElement
        Dim TextString As String

        TextString = frmNieuwProject.txtProject.Value
        Set oText = FindTextID(ActiveModelReference, idProjectnummer, TextString)

        TextString = frmNieuwProject.txtCalculatie.Value
        Set oText = FindTextID(ActiveModelReference, idCalculatienummer, TextString)

        TextString = frmNieuwProject.txtOpdrachtgever.Value
        Set oText = FindTextID(ActiveModelReference, idOpdrachtgever, TextString)

        TextString = frmNieuwProject.txtOmschrijving.Value
        Set oText = FindTextID(ActiveModelReference, idProject, TextString)

    End If
End If

End Sub

This works, when I need the values back I use:

Private Sub UserForm_initialize()
   
Dim ele As TextElement
Dim idProjectnummer As DLong
Dim idCalculatienummer As DLong
Dim idCalculatiepositie As DLong
Dim idOpdrachtgever As DLong
Dim idBenaming As DLong
Dim idProject As DLong
Dim Calculatienaam As String * 6
Dim Pos As ModelReference
If WelkeID() = "Nieuw" Then
    idProjectnummer = DLongFromString("25428")
    idCalculatienummer = DLongFromString("25429")
    idOpdrachtgever = DLongFromString("25425")
    idProject = DLongFromString("25424")
    idBenaming = DLongFromString("25401")
    idPositienummer = DLongFromString("25430")
Else
    idOpdrachtgever = DLongFromString("325105")
    idBenaming = DLongFromString("325104")
    idProject = DLongFromString("325103")
    idProjectnummer = DLongFromString("325106")
    idCalculatienummer = DLongFromString("325107")
    idPositienummer = DLongFromString("325100")
End If

Set Pos = ActiveDesignFile.Models("Default")
'------------------------------------------------------------------------------------------------------
        Dim oText As TextElement
        Dim TextString As String


        Set oText = FindTextID(Pos, idProjectnummer, TextString)
        lblProjectNr.Caption = FindTextID(Pos, idProjectnummer, TextString)
        Set oText = Nothing
        
        Set oText = FindTextID(Pos, idCalculatienummer, TextString)
        lblCalculatieNr.Caption = FindTextID(ActiveModelReference, idOpdrachtgever, TextString)
        Set oText = Nothing
        
        Set oText = FindTextID(Pos, idOpdrachtgever, TextString)
        lblOpdrachtgever.Caption = FindTextID(ActiveModelReference, idOpdrachtgever, TextString)
        Set oText = Nothing
        
        Set oText = FindTextID(Pos, idProject, TextString)
        lblProjectOmschr.Caption = FindTextID(ActiveModelReference, idOpdrachtgever, TextString)
        Set oText = Nothing
        

Immediate windows contains:

Found element type 2 ID=29632
oComponents is :29573
oComponents is :29565
oComponents is :29566
oComponents text is :29567
oComponents is :29569
oComponents text is :29570
oComponents text is :29571
oComponents text is :29572
oComponents is :25400
oComponents text is :25401
oComponents text is :25404
oComponents text is :25406
oComponents text is :25407
oComponents text is :25408
oComponents text is :25409
oComponents text is :25410
oComponents text is :25411
oComponents text is :25412
oComponents text is :25413
oComponents text is :25414
oComponents text is :25416
oComponents text is :25417
oComponents text is :25418
oComponents text is :25419
oComponents text is :25420
oComponents text is :25421
oComponents text is :25423
oComponents text is :25424
oComponents text is :25425
oComponents text is :25426
oComponents text is :25428
 text found by function
oComponents is :29574
oComponents text is :29575
oComponents text is :29576
oComponents text is :29577
oComponents text is :29578
oComponents text is :29579
oComponents text is :29580
oComponents text is :29581
oComponents text is :29582
oComponents text is :29583
oComponents text is :29584
oComponents text is :29585
oComponents text is :29586
oComponents text is :29598
oComponents text is :29599
oComponents text is :29600
oComponents text is :29603
oComponents text is :29604
oComponents text is :29605

Question now is how to get back the value's from the dgn model.

Also I thought today, what if Bentley fixes the bug, would my new code still work?

Thanks,

Leo

Leo van der Hoeven said:

Question now is how to get back the value's from the dgn model

This thread has grown enormously.  You're adding new questions, and clearly struggling with VBA.

I think you should hire a consultant who knows MicroStation VBA intimately, who can sort out your problems.

Jon Summers said:

This thread has grown enormously.

I agree, it has become nearly impossible to follow and understand the whole discussion including its context.

Jon Summers said:

and clearly struggling with VBA.

I have seen more such problems in several discussion recently, when the migration is done not enough skilled programmer.

I guess it's because companies finally have started to think about migration to CONNECT Edition, so applications and macros are migrated to the new environment. Unfortunately, probably because "it's just VBA", it's treated as simple task, even when often the migrated macros have grown step by step to a huge size and complexity (and should therefore be rewritten to at least NET or even C/C++). But legacy code transformation is typically substantially more complex than to write a new code from scratch, requiring extra knowledge and skills, plus with basic VBA editor functionality and missing any advanced tool(s), it's can be really complicated and time consuming project.

So no quick and simple solution or advice is available, unfortunately...

Regards,

  Jan

Hi Jon and all,

I thought I'd let you all know I finally figured it out, and the functions I needed are running nicely now. The zip file you uploaded was very helpful. so for me this line can be closed.

It's thru there are still a lot off things for me to learn in vba, but just because things are hard and I'm struggling doesn't mean I'm going to give up. For me one of the biggest reasons I'm doing this is to learn programming, so I'll keep on going. It does seem funny to me that from all the problems Ive encountered so far this one was the hardest to fix, and it's all caused by a bug of the pro's.

But I guess that's life,

So for now, sorry for all the stupid questions, and farewell.

Thanks,

Leo

Leo van der Hoeven said:

One of the biggest reasons I'm doing this is to learn programming. Sorry for all the stupid questions

No question is stupid: keep asking them here!  Although, if you want to learn VBA, MicroStation isn't the best place to start.  Excel, for example, has user groups, web sites and printed publications for programmers. 

Leo van der Hoeven said:

So for now, farewell

I hope not: better tot ziens.

Hi Jon,

I see you picked up some dutch on the way, Nice.

I'm aware of Excel vba, and made some things in it. And indeed for some reason the excel version of VBA is somehow much easier. Probably since there are far more people working with it, so there is more info to find. and there is much less to do whit objects.

But the man at work gave me the care for maintaining our microstation, so now I have a good reason to study it's vba.

So I'll probably meet you here again

Regards,

Leo