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