ASCII グリッドをラスターに変換して空間参照を定義

'ラスタをASCIIグリッドに変換し、さらに投影法を定義して新しいRasterDatasetを作成するサンプル
'ラスタの設定を変更すると上書きできないので、ASCII変換用に一旦テンポラリのRasterDatasetを作成している
 
Sub subConvertASCII2Raster()
 
'ASCIIファイルフルパス
Dim srcFile As String
srcFile = "F:\My Documents\SpatialData\Raster\ASCII\ASCII_Raster.txt"
 
'RasterDatasetを格納するWorkspace
Dim dstDir As String
dstDir = "F:\My Documents\SpatialData\Raster\ASCII\"
 
'RasterDataset名
Dim dstName As String
dstName = "RasterName"
 
'テンポラリRasterDataset名
Dim dstNameTemp As String
dstNameTemp = "Temp"
 
'RasterConversionOpオブジェクトの作成
Dim pRasterImportOp As IRasterImportOp
Set pRasterImportOp = New RasterConversionOp
 
Dim pRasterWS As IWorkspace
Set pRasterWS = OpenRasterWorkspace(dstDir)
 
Dim pRasterDs As IRasterDataset2
Set pRasterDs = pRasterImportOp.ImportFromASCII(srcFile, pRasterWS, dstNameTemp, "GRID", False)
 
Dim pRasterProps As IRasterProps
Set pRasterProps = pRasterDs.CreateDefaultRaster
 
Dim pRasterBandCollection As IRasterBandCollection
Set pRasterBandCollection = pRasterProps
 
pRasterProps.SpatialReference = fncSpatialReference(esriSRProjCS_JGD2000_Japan_Zone_9, False)
 
Dim pRasterDs2 As IRasterDataset
Set pRasterDs2 = pRasterBandCollection.SaveAs(dstName, pRasterWS, "GRID")
 
Call subDeleteRaster
 
End Sub
 
Sub subDeleteRaster()
 
Dim srcFile As String
srcFile = "F:\My Documents\SpatialData\Raster\ASCII\ASCII_Raster.txt"
 
Dim dstDir As String
dstDir = "F:\My Documents\SpatialData\Raster\ASCII\"
 
Dim dstName As String
dstName = "RasterName"
 
 
Dim dstNameTemp As String
dstNameTemp = "Temp"
 
DeleteRaster dstDir, dstNameTemp
 
End Sub
 
 
Public Function DeleteRaster(dir As String, name As String) As Boolean
    Dim pRDS As IRasterDataset
    Set pRDS = OpenRasterDataset(dir, name)
     
    Dim pDS As IDataset
    Set pDS = pRDS
     
    If pDS.CanDelete = True Then
        pDS.delete
        DeleteRaster = True
    Else
        MsgBox "データセットを削除できません", vbExclamation, "エラー"
    End If
     
End Function
 
Public Function OpenRasterDataset(sDir As String, sName As String) As IRasterDataset
  Dim pRW As IRasterWorkspace
  Set pRW = OpenRasterWorkspace(sDir)
  Set OpenRasterDataset = pRW.OpenRasterDataset(sName)
End Function
 
 
Public Function OpenRasterWorkspace(sDir As String) As IRasterWorkspace
  Dim pRasterWSFact As IWorkspaceFactory
  Set pRasterWSFact = New RasterWorkspaceFactory
  Set OpenRasterWorkspace = pRasterWSFact.OpenFromFile(sDir, 0)
End Function
 
 
Function fncSpatialReference(valType As Variant, blnGeographic As Boolean) As ISpatialReference
  
 'DeveloperHelpから以下を参照
  
 '地理座標系(pcsType)
 'esriSRGeoCSType Contains
 'esriSRGeoCS2Type Constants
 'esriSRGeoCS3Type Constants
  
 '投影座標系(gcsType)
 'esriSRProjCSType Constants
 'esriSRProjCS2Type Constants
 'esriSRProjCS3Type Constants
 'esriSRProjCS4Type Constants
  
 '例
 'valType = esriSRProjCS_JGD2000_Japan_Zone_9     'JGD2000 平面直角座標系第9系
 'valType = esriSRGeoCS_JapanGeodeticDatum2000    'JGD2000 地理座標系
  
 Dim pSpatialReferenceFactory As ISpatialReferenceFactory
 Set pSpatialReferenceFactory = New SpatialReferenceEnvironment
  
 If blnGeographic = True Then
     Dim pGeographicCoordinateSystem As IGeographicCoordinateSystem
     Set pGeographicCoordinateSystem = pSpatialReferenceFactory.CreateGeographicCoordinateSystem(valType)
      
     Set fncSpatialReference = pGeographicCoordinateSystem
      
 Else
     Dim pProjectedCoordinateSystem As IProjectedCoordinateSystem
     Set pProjectedCoordinateSystem = pSpatialReferenceFactory.CreateProjectedCoordinateSystem(valType)
  
     Set fncSpatialReference = pProjectedCoordinateSystem
 End If
  
 End Function