CoordSys Example


Imports an existing projection file and allows you to modify the Flattening property. The modified coordinate system is then exported to a new projection file

VBScript Code

Copy Code
 Sub ModifyCoordSys
      'Create a CoordSys object
    Dim pCoordSys, strExistingPrjFile
      Set pCoordSys = Application.CreateAppObject ("CoordSys")
      'Get an existing projection file via an Open dialog box
    strExistingPrjFile = CommonDialog.ShowOpen ("prj", "Projection Files|*.prj", "Choose Original Projection")
      If Not IsEmpty (strExistingPrjFile) Then
          pCoordSys.Import (strExistingPrjFile)
          Set pCoordSys = Nothing
            Exit Sub
    End If
    'Display the parameters of the selected projection file in a message box
      Application.MessageBox "Projection Name: " & pCoordSys.ProjectionName & apNewLine &_
                "Datum: " & pCoordSys.DatumName & apNewLine &_
              "Geographic Name: " & pCoordSys.GeographicName & apNewLine &_
                "Flattening: " & CStr(pCoordSys.Flattening) & apNewLine &_
              "SemiMajor Axis: " & CStr(pCoordSys.SemiMajorAxis)   _
              , apInformation, pCoordSys.ProjectionName
    'Prompt the user for a new Flattening value
      Dim strResponse, blnValid, dblNewFlattening
    blnValid = False
    Do Until blnValid
            strResponse = InputBox ("The current Flattening is " & CStr(pCoordSys.Flattening) & Vbcr &_
                                    "Please enter the new Flattening.", "Enter New Flattening", "0")
              If IsEmpty (strResponse) Then
                    Set pCoordSys = Nothing
                Exit Sub
            End If
            If IsNumeric (strResponse) Then
                blnValid = True
            End If
    dblNewFlattening = CDbl(strResponse)
    'Update the Flattening with the one entered by the user
      pCoordSys.Flattening = dblNewFlattening
    'Let the user know the update was successful
      MsgBox "The coordinate system has been updated. The new projection string is:" & Vbcr &_
                pCoordSys.String, vbInformation, "Coordinate System Updated"
      'Export the modified coordinate system to a new projection file
    Dim strNewPrjFile
      strNewPrjFile = CommonDialog.ShowSave ("untitled", "prj", "Projection Files|*.prj", "Save Projection File")
      If Not IsEmpty (strNewPrjFile) Then
          pCoordSys.Export (strNewPrjFile)
      End If
      'Free resources
    Set pCoordSys = Nothing
End Sub