VBA to Reference Files and Set Geographic Coordinates.

Hi All,

I'm having some problems with a Project at work. I am trying to speed up the process for our users to Import GIS Data that has been extracted from our GIS System

The Extract file works fine when i opened it in MicroStation, attach the coordinate system and export to Google Earth, but the boss wants to do more with it.

Essentially I would like to do the following through VBA.

  • User select the GIS Data file

  • Program creates an additional Design Model for the GIS Data

  • Program attaches reference file, then merges into master

  • Coordinate System is set to be MGA94-50

  • GIS Model is then Referenced into the main Design Model

Below is my code... if i do these steps manually it works, however this code gives me the attached Google Earth file (I am using google Earth simply to check that the design is in the correct coordinates)

The design should be in Esperance, Western Australia.... Not off the coast off Mexico... Also the Google Earth Image is bizzare!!


Dim sFile As String
Dim sImportFile As String
Dim oFile As DesignFile
Dim oDesignFile As DesignFile
Dim oModel As ModelReference
Dim oRef As Attachment

'Select GIS Extract File
CommonDialog.DialogTitle = "Select .DGN File"
CommonDialog.Filter = "MicroStation DGN Files (*.dgn)|*.DGN"
CommonDialog.ShowOpen

If FileExists(CommonDialog.FileName) = False Then
MsgBox "File Not Found, Please try again", vbCritical,
End
End If
sImportFile = CommonDialog.FileName

'Create GIS Model
sFile = ActiveWorkspace.ConfigurationVariableValue("_HP_DIR") & "SEED\Sheets.dgn"
Set oFile = OpenDesignFileForProgram(sFile, True)
For Each oModel In oFile.Models
If oModel.Name = "Default" Then
Set template = oFile.Models.Item("Default")
End If
Next
For Each oModel In ActiveDesignFile.Models
If oModel.Name = "GIS Data" Then
If MsgBox("GIS Data already exists in Current Design File....Do you wish to replace it?", vbYesNo + vbExclamation, sMSGTitle) = vbYes Then
Set oModel = ActiveDesignFile.Models("GIS Data")
If ActiveModelReference.Name = "GIS Data" Then
ActiveDesignFile.Models.Item("Default").Activate
ActiveDesignFile.Models.Delete oModel
GoTo AddModel
Else
ActiveDesignFile.Models.Delete oModel
GoTo AddModel
End If
Else
GoTo ExitSub
End If
End If
Next
AddModel:
ActiveDesignFile.Models.Add template, "GIS Data", "GIS Extract", msdModelTypeDefault, True
ActiveDesignFile.Models.Item("GIS Data").Activate
oFile.Close

CadInputQueue.SendKeyin "geocoordinate assign MGA94-50"
Set oRef = ActiveModelReference.Attachments.AddCoincident(sImportFile, "Default", "GIS Data", "GIS Data Extract")

Dim oRefLevel As Level
For Each oRefLevel In oRef.Levels
If oRefLevel.Name = "BASE" Then
oRefLevel.IsDisplayed = False
ElseIf oRefLevel.Name = "Pole" Then
oRefLevel.IsDisplayed = False
ElseIf oRefLevel.Name = "SPID Anno" Then
oRefLevel.IsDisplayed = False
End If
Next

CadInputQueue.SendKeyin "fit view extended"

'merge reference
Dim att As Attachment
For Each att In ActiveModelReference.Attachments
If att.Name = "Default" Then
CopyGraphicalElements ActiveModelReference, att
ActiveModelReference.Attachments.Remove att
End If
Next


'Attach GIS data to Default model
ActiveDesignFile.Models.Item("Default").Activate
CadInputQueue.SendKeyin "geocoordinate assign MGA94-50"
Set oRef = ActiveModelReference.Attachments.AddCoincident(ActiveDesignFile.FullName, "GIS Data", "GIS Data", "GIS Extract")

' ShowMessage "Coordinate System Set...", "MGA94-50 has been set for the current model and GIS model", msdMessageCenterPriorityInfo
Unload Me

CadInputQueue.SendReset
CommandState.StartDefaultCommand


It seems like the problem is the attach reference line, but if i add the reference manually and ensure its placement is "coincident" it will work?

Any advice would be greatly appreciated!

Rob.zip
Parents
  • Perhaps it is just a synchronization problem where you are attaching reference file earlier then it has chosen correct coordinate system. You are using SendKeyin function which just adds keyin at the end of input queue, but does not wait until it is executed. Unfortunately, VBA does not have a function to send synchronized keyin, however it can use MDL to do it.

    Please, try to call ALL keyins using following SendSyncKeyin routine and let us know whether it works:

    Option Explicit

    Declare Sub mdlInput_sendSynchronizedKeyin Lib "stdmdlbltin.dll" ( _
     ByVal stringP As StringByVal literal As Long, _
     ByVal position As LongByVal taskIdP As String)

    Sub SendSyncKeyin(expr As String)
      mdlInput_sendSynchronizedKeyin expr, 0, -1, vbNullString
    End Sub
  • Thanks Dan,

    Have tried the SendSyncKeyin and unfortunately it's the same result... the coordinate system is off and the Extract file covers the entire globe!!

  • Further to this...

    If i open the GIS File i want to import and set the Coordinates to MGA94-50 the Google Earth file is correct... so i know its in the right coordinates.

    I'm not an expert but the only thing i can think of is the code to attach the reference... is there another way to do this through code?

Reply Children