フィーチャをラスターに変換

Attribute VB_Name = "Module_Feature2Raster"
Option Explicit
 
'*********************************************************************
' 定義 :fncCreateRaster(valIndex As Integer, valFieldName As String,
'           valCellSize As Double, valRasterFormat As String,
'           valOutputFilePath As String, valOutputFilename As String)
' 概要 :フィーチャをラスタに変換（エクステンションライセンス不要）
' 第1引数 :IFeatureLayer    'フィーチャレイヤ
' 第2引数 :String           'フィールド名
' 第3引数 :Double           '出力セルサイズ
' 第4引数 :String           '出力ファイルパス
' 第5引数 :String           '出力ファイル名
' 第6引数 :String Optional  '出力フォーマット（オプション）
' 戻り値 :IRasterLayer      'ラスタレイヤ
' 更新履歴 :2006/01/11 新規作成
'*********************************************************************
Function fncCreateRaster(pFeatureLayer As IFeatureLayer, valFieldName As String, _
    valCellSize As Double, valOutputFilePath As String, valOutputFileName As String, _
    Optional valRasterFormat As String) As IRasterLayer
     
    '出力フォーマットが指定されていない場合はESRI GRIDで出力
    If valRasterFormat = "" Then
        valRasterFormat = "GRID"
    End If
     
    'フィーチャクラスの取得
    Dim pFeatureClass As IFeatureClass
    Set pFeatureClass = pFeatureLayer.FeatureClass
     
    'フィーチャクラスディスクリプタの作成
    Dim pFeatCDr As IFeatureClassDescriptor
    Set pFeatCDr = New FeatureClassDescriptor
    pFeatCDr.Create pFeatureClass, Nothing, valFieldName
     
    'ConversionOpオブジェクトの作成
    Dim pConvOp As IConversionOp
    Set pConvOp = New RasterConversionOp
     
    '出力ラスタセルサイズの設定
    Dim pRAEnv As IRasterAnalysisEnvironment
    Set pRAEnv = pConvOp
    pRAEnv.SetCellSize esriRasterEnvValue, valCellSize
     
    Dim pWSF As IWorkspaceFactory
    Set pWSF = New RasterWorkspaceFactory
     
    Dim pRWS As IRasterWorkspace
    Set pRWS = pWSF.OpenFromFile(valOutputFilePath, 0)
     
    Dim pRasterDataset As IRasterDataset
    Set pRasterDataset = pConvOp.ToRasterDataset(pFeatCDr, valRasterFormat, pRWS, valOutputFileName)
     
    'ラスタレイヤの追加
    Dim pRaster As IRaster
    Set pRaster = pRasterDataset.CreateDefaultRaster
     
    Dim pRasterLayer As IRasterLayer
    Set pRasterLayer = New RasterLayer
    pRasterLayer.CreateFromRaster pRaster
     
    Set fncCreateRaster = pRasterLayer
     
End Function