空間参照の定義（詳細）

'******************************************************************************  定義 :fncCreateSpatialReference() As ISpatialReference
' 概要 :正距方位図法(AzimuthalEquidistant)（GCS_WGS84）の設定
' 第1引数 :Double '10進緯度
' 第2引数 :Double '10進経度
' 戻り値 :ISpatialReference
'*****************************************************************************
Function fncCreateSpatialReference(lat As Double, lon As Double) As ISpatialRefeence
On Error GoTo ErrorHandler
 
'変数設定
Dim varProjection As Variant
Dim varUnit As Variant
Dim varGCS As Variant
 
Dim varName As String
Dim varAlias As String
Dim varAbbreviation As String
Dim varRemarks As String
 
'変数設定
varProjection = esriSRProjection_AzimuthalEquidistant   '投影法
varUnit = esriSRUnit_Kilometer          '投影法の距離単位
varGCS = esriSRGeoCS_WGS1984            '投影法に設定する測地基準系
 
varName = "AzimuthalEquidistant"
varAlias = "正距方位図法"
varAbbreviation = ""
varRemarks = ""
 
 
'投影座標系オブジェクトを作成する
Dim pSpatRefFact As ISpatialReferenceFactory
Set pSpatRefFact = New SpatialReferenceEnvironment
 
'投影の定義
Dim pProjection As IProjection
Set pProjection = pSpatRefFact.CreateProjection(varProjection)
 
'投影単位の設定
Dim pUnit As ILinearUnit
Set pUnit = pSpatRefFact.CreateUnit(varUnit)
 
'地理参照の設定
Dim pGCS As IGeographicCoordinateSystem
Set pGCS = pSpatRefFact.CreateGeographicCoordinateSystem(varGCS)
 
'パラメータの定義
'パラメータ設定数は投影法によって変更される
Dim aParamArray(3) As IParameter
Set aParamArray(0) = pSpatRefFact.CreateParameter(esriSRParameter_FalseEasting) 東距
aParamArray(0).Value = 0
Set aParamArray(1) = pSpatRefFact.CreateParameter(esriSRParameter_FalseNorthing)'北距
aParamArray(1).Value = 0
Set aParamArray(2) = pSpatRefFact.CreateParameter(esriSRParameter_CentralMeridia) '中心経度
aParamArray(2).Value = lon
Set aParamArray(3) = pSpatRefFact.CreateParameter(esriSRParameter_LatitudeOfOrign) '中心緯度
aParamArray(3).Value = lat
 
'新規投影定義の作成
Dim pProjCoordSys As IProjectedCoordinateSystem
Set pProjCoordSys = New ProjectedCoordinateSystem
 
'QI
Dim pProjCoordSysEdit As IProjectedCoordinateSystemEdit
Set pProjCoordSysEdit = pProjCoordSys
 
pProjCoordSysEdit.Define Name:=varName, Alias:=varAlias, Abbreviation:=varAbbrevation, _
Remarks:=varRemarks, gcs:=pGCS, projectedUnit:=pUnit, Projection:=pProjection, Prameters:=aParamArray
 
'作成した投影定義を設定
Dim pSpatRef As ISpatialReference
Set pSpatRef = pProjCoordSys
 
Set fncCreateSpatialReference = pSpatRef
 
 
 
'XY座標精度の設定（9.2以降は設定必須）
Dim pSpatialReferenceResolution  As ISpatialReferenceResolution
Set pSpatialReferenceResolution = pSpatRef 
pSpatialReferenceResolution.SetDefaultXYResolution
 
'XY許容値の設定（9.2以降は設定必須）
Dim pSpatialReferenceTolerance  As ISpatialReferenceTolerance
Set pSpatialReferenceTolerance = pSpatRef 
pSpatialReferenceTolerance.SetDefaultXYTolerance
 
 
Exit Function 'エラーハンドル回避
 
ErrorHandler:
MsgBox Err.Description
Resume Next
 
End Function