Quantcast
Channel: MicroStation Programming - Forum - Recent Threads
Viewing all articles
Browse latest Browse all 383

VBA to Reference Files and Set Geographic Coordinates.

$
0
0

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!


Viewing all articles
Browse latest Browse all 383

Latest Images

Trending Articles



Latest Images

<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>