Microstation VBA Batch Cell Replacement

I have created a program which will go through all my DGN drawings that are in many sub folders in a Master Folder. ( Example:   C:/MasterFolder/Subfolder/1234.DGN)

My program goes through each element looking for specific cell name and when it does find it, it will retrieve the origin X & Y points. Using the Record macro and changing a bit of the code, it will replace the cell with the new cell at the same location retrieved earlier. 

Now i am updating about 12,000+ DGN files, and for every file, every cell it finds, it opens up the cell library window so it can do a "placement". I can only get to about 36 jobs before either the macro or microstation enters the "Not Responding" phase, and gets stuck in that phase and does not continue on until i force quit the program. I suspect the cell library window being opened too frequent and too fast so microstation can not keep up and freezes/crashes. Is there a way i can do this same technique/method without it freezing? could i use something called keyins? The best would be if someone knows another way of doing a "Placement" on a cell without opening the cell library window, that might fix the problem.

i have a form with a button and two labels, i click the button, a window pops up asking me to select the "Master Folder", click ok. then the program starts running. there are 10 cells i wanna replace, for each cell it will go through all DGN files in the sub folders. so let's say 10 cells X 12,000  .... so 120,000 files. This is how my program works.

i have a userform1 (excel), and a class module Macro1ModalHandler.

I have posted my code below:

Userform1: 

Option Explicit

Dim counter As Integer
Dim xcoord, ycoord As Integer
Dim CellName As Variant
Dim i As Double

Private Sub CommandButton1_Click()
On Error Resume Next:
     'this chunk of code opens up a new window for users to select the folder which the files are in
    Dim myFSO As New Scripting.FileSystemObject
    Dim myFolder As Scripting.Folder
    Dim myFile As Scripting.File
    Dim myFoldering As Scripting.Folder
    
    Dim myShell As New Shell32.Shell
    Dim myRootFolder As Shell32.Folder3
    Set myRootFolder = myShell.BrowseForFolder(0, "Pick", 0)
    If myRootFolder Is Nothing Then Exit Sub
    
    Set myFolder = myFSO.GetFolder(myRootFolder.Self.Path)
    

    Dim FSOS As New FileSystemObject
    Dim myFolderS As Folder
    Dim mySubFolderS As Folder

    Set myFolderS = myFSO.GetFolder(myRootFolder.Self.Path)
    For Each mySubFolderS In myFolderS.SubFolders
        For Each myFile In mySubFolderS.Files
            Select Case UCase(Right(myFile.Name, 3))
                Case "DGN"
                    OpenDesignFile myFile.Path, False, msdV7ActionWorkmode
                    Label1.Caption = myFile.Path
                    
                    For i = 1 To 10 Step 1
                        If i = 1 Then CellName = "16041"
                        If i = 2 Then CellName = "1604"
                        If i = 3 Then CellName = "16042"
                        If i = 4 Then CellName = "160422"
                        If i = 5 Then CellName = "160423"
                        If i = 6 Then CellName = "B50031"
                        If i = 7 Then CellName = "B50032"
                        If i = 8 Then CellName = "B50033"
                        If i = 9 Then CellName = "B4003C"
                        If i = 10 Then CellName = "B4003O"
                        Call getting
                    Next i
                    
                    CadInputQueue.SendCommand "FILEDESIGN"
            End Select
        Next
        
    Next
     
    MsgBox "finished"

End Sub

Sub getting()
Dim oCriteria As New ElementScanCriteria
Dim oCriteriaText As New ElementScanCriteria
Dim ee As ElementEnumerator 'ElementEnumerator is how it is able to search through the entire model for a specific element
Dim et As ElementEnumerator
Dim tc As CellElement
Dim myTextNode As TextNodeElement
Dim myTextNode1 As TextNodeElement
Dim myTextNode2 As TextNodeElement
Dim myTextNode3 As TextNodeElement
Dim tf As Element
Dim target As TextElement
Dim IDholder As DLong

    oCriteria.ExcludeAllTypes
    oCriteria.IncludeType msdElementTypeCellHeader
    oCriteria.IncludeType msdElementTypeSharedCell
    
    'searches for references that fits the criteria ( type header, and shared cell) and sets it as ee
    Set ee = ActiveModelReference.Scan(oCriteria)
    
    Do While ee.MoveNext
        If ee.Current.AsCellElement.Name = CStr(CellName) Then  '<------name this something different for different changes
            oCriteria.ExcludeAllTypes
            oCriteria.IncludeType msdElementTypeCellHeader
            oCriteria.IncludeType msdElementTypeSharedCell
            oCriteria.IncludeOnlyCell CStr(CellName) '<------name this something different for different changes
        End If
    Loop
    
   
    Set ee = ActiveModelReference.Scan(oCriteria)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'DO NOT CHANGE SCALING FACTORS/NUMBER UNLESS NECESSARY
    Do While ee.MoveNext
        Set tc = ee.Current
        tc.ResetElementEnumeration
        
        xcoord = tc.Origin.X
        ycoord = tc.Origin.Y
        
        Call stuff
    Loop
    
    
End Sub

Sub stuff()
    Dim startPoint As Point3d
    Dim point As Point3d, point2 As Point3d
    Dim lngTemp As Long

'   Start a command
    CadInputQueue.SendCommand "DIALOG CELLMAINTENANCE TOGGLE"

    Dim modalHandler As New Macro1ModalHandler
    AddModalDialogEventsHandler modalHandler

'   The following statement opens modal dialog "Attach Cell Library"

    CadInputQueue.SendCommand "ATTACH LIBRARY"

'   Set a variable associated with a dialog box
    SetCExpressionValue "tcb->activeCell", CStr(CellName), ""

    CadInputQueue.SendCommand "REPLACE CELLS EXTENDED"

'   Coordinates are in master units
    startPoint.X = xcoord
    startPoint.Y = ycoord
    startPoint.Z = 0#

'   Send a data point to the current command
    point.X = startPoint.X
    point.Y = startPoint.Y
    point.Z = startPoint.Z
    CadInputQueue.SendDataPoint point, 1

    point.X = startPoint.X
    point.Y = startPoint.Y
    point.Z = startPoint.Z
    CadInputQueue.SendDataPoint point, 1

    RemoveModalDialogEventsHandler modalHandler
    CommandState.StartDefaultCommand
End Sub



Class Module

Implements IModalDialogEvents
Private Sub IModalDialogEvents_OnDialogClosed(ByVal DialogBoxName As String, ByVal DialogResult As MsdDialogBoxResult)

End Sub

Private Sub IModalDialogEvents_OnDialogOpened(ByVal DialogBoxName As String, DialogResult As MsdDialogBoxResult)

    If DialogBoxName = "Attach Cell Library" Then

        CadInputQueue.SendCommand "MDL COMMAND MGDSHOOK,fileList_setDirectoryCmd J:\Microstation\WSMOD\Medesign\V8_Cells\MECELIB\"

        CadInputQueue.SendCommand "MDL COMMAND MGDSHOOK,fileList_setFileNameCmd parts.cel"

    '   Remove the following line to let the user close the dialog box.
        DialogResult = msdDialogBoxResultOK

    End If  ' Attach Cell Library

End Sub

 

Parents
  • I didn't take a close look at everything in your code, but found a few glaring things that should be cleaned up.

    1. The first thing is that some of your variables are miscast. For example your xcoord and ycoord variables are set to Integer when they storing double values. For better efficiency these are should be replaced by a single Point3d data type.

    2. You can issue key-in commands to replace the reliance on the modal dialog handler, you will see that in the update to your stuff sub below.

    3. Which brings me to my next point, name your functions a subs with more meaningful names.

    4. I'm not sure why you were doing the double scan of the model to grab the cells and find the cells by name. That can be done in a single scan.

    5. Don't try to process all 12000+ dgn files at once. Divide the processing into smaller sets of jobs/projects.

    I've made some updates to your getting and stuff routines and posted them below.

    Const CELL_LIB_NAME As String = "J:\Microstation\WSMOD\Medesign\V8_Cells\MECELIB\parts.cel"

     

    'These are double values, and should be stored in a single Point3d data type
    'Dim xcoord, ycoord As Integer

    Dim ptOrigin As Point3d


    'Don't use Variants unless absolutely necessary
    'Names are stored as Strings
    'Dim CellName As Variant

    Dim CellName As String

    'This counter/index variable is really an Integer value
    'Dim i As Double

    Dim i As Integer

    Sub getting()

    Dim oCriteria As New ElementScanCriteria
    Dim ee As ElementEnumerator 'ElementEnumerator is how it is able to search through the entire model for a specific element
    Dim tc As CellElement

    With oCriteria

    .ExcludeAllTypes
    .IncludeType msdElementTypeCellHeader
    .IncludeType msdElementTypeSharedCell
    .IncludeOnlyCell CellName

    End With


    ' 'searches for references that fits the criteria ( type header, and shared cell) and sets it as ee
    ' Set ee = ActiveModelReference.Scan(oCriteria)
    '
    ' Do While ee.MoveNext
    ' If ee.Current.AsCellElement.Name = CStr(CellName) Then '<------name this something different for different changes
    ' oCriteria.ExcludeAllTypes
    ' oCriteria.IncludeType msdElementTypeCellHeader
    ' oCriteria.IncludeType msdElementTypeSharedCell
    ' End If
    ' Loop
    '

    Set ee = ActiveModelReference.Scan(oCriteria)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'DO NOT CHANGE SCALING FACTORS/NUMBER UNLESS NECESSARY
    Do While ee.MoveNext

    Set tc = ee.Current
    'tc.ResetElementEnumeration

    'xcoord = tc.Origin.X
    'ycoord = tc.Origin.Y

    ptOrigin = tc.Origin
    Call stuff

    Loop

    End Sub


    Sub stuff()

    With CadInputQueue

    .SendCommand "rc=" & CELL_LIB_NAME
    .SendCommand "ac=" & CellName
    .SendCommand "REPLACE CELLS EXTENDED"
    .SendDataPoint ptOrigin
    .SendDataPoint ptOrigin

    End With

    CommandState.StartDefaultCommand

    End Sub

    Rod Wing
    Senior Systems Analyst

  • thank you for the reply, i was wondering. is there a way to have a timer in microstation? i have searched but have had no luck
  • Unknown said:
    Is there a way to have a timer in MicroStation?

    Search VBA help for keyword timer.

     
    Regards, Jon Summers
    LA Solutions

  • btw what is CELL_LIB_NAME?

    ".SendCommand "rc=" & CELL_LIB_NAME"
  • If you look at the first line of code I posted it is defined as a constant set to the location of your cell lib

    Const CELL_LIB_NAME As String = "J:\Microstation\WSMOD\Medesign\V8_Cells\MECELIB\parts.cel"


    It's a good idea to define things like this at the top of your code module so that if you want to modify this to run against a different cell library you don't have to go searching through your code.

    Rod Wing
    Senior Systems Analyst

  • I don't understand why you don't just use the batch processor in microstation and use the function replace cell..

    if all your cell libraries are defined in your workspace and the cell names are unique then the replace cell command can be placed into the batch processor script

    first for one defined cell , then the others in turn   this came be saved and rerun  say on several files at a time or the whole folder you need to end with file design so it saves the changes... much easier with the internal tools than coming up with vba and you can run it overnight and it wont crash...

    Try it with just 2 or 3 test files first and you'll work it out in no time... I love the batch processor...

    Lorys

    Started msnt work 1990 - Retired  Nov 2022 ( oh boy am I old )

    But was long time user V8iss10 (8.11.09.919) dabbler CE  update 16 (10.16.00.80) 

    MicroStation user since 1990 Melbourne Australia.
    click link to PM me 

Reply
  • I don't understand why you don't just use the batch processor in microstation and use the function replace cell..

    if all your cell libraries are defined in your workspace and the cell names are unique then the replace cell command can be placed into the batch processor script

    first for one defined cell , then the others in turn   this came be saved and rerun  say on several files at a time or the whole folder you need to end with file design so it saves the changes... much easier with the internal tools than coming up with vba and you can run it overnight and it wont crash...

    Try it with just 2 or 3 test files first and you'll work it out in no time... I love the batch processor...

    Lorys

    Started msnt work 1990 - Retired  Nov 2022 ( oh boy am I old )

    But was long time user V8iss10 (8.11.09.919) dabbler CE  update 16 (10.16.00.80) 

    MicroStation user since 1990 Melbourne Australia.
    click link to PM me 

Children
No Data