Sub GetUniqueVal() Dim pMxdoc As IMxDocument Dim pMap As IMap Dim pFLayer As IFeatureLayer Dim pFClass As IFeatureClass Dim pFCursor As IFeatureCursor Set pMxdoc = ThisDocument Set pMap = pMxdoc.FocusMap Set pFLayer = pMap.Layer(0) Set pFClass = pFLayer.FeatureClass Dim pFields As IFields Dim i As Long Dim pField As IField Dim pDomain As IDomain Set pFields = pFClass.Fields i = pFields.FindField("FAC_IDFR") Set pField = pFields.Field(i) Set pDomain = pField.Domain 'Debug.Print pDomain.Description & "," & pDomain.Name & "," & pDomain.Type Select Case pDomain.Type Case Is = esriDomainType.esriDTCodedValue Dim pCVDomain As ICodedValueDomain Set pCVDomain = pDomain ' Dim icnt As Integer ' For icnt = 0 To pCVDomain.CodeCount - 1 ' Debug.Print (pCVDomain.Name(icnt) & "," & pCVDomain.value(icnt)) ' Next Case Is = esriDomainType.esriDTRange Dim pRDomain As IRangeDomain Set pRDomain = pDomain Case Is = esriDomainType.esriDTString Dim pSDomain As IStringDomain Set pSDomain = pDomain End Select ' Dim pFields As IFields ' Set pFields = pFClass.Fields ' Dim icnt As Integer Dim ufrm As New UserForm3 ' For icnt = 0 To pFields.FieldCount - 1 ' ufrm.lstFileds.AddItem pFields.Field(icnt).Name, icnt ' Next Dim pCursor As ICursor Set pCursor = pFClass.Search(Nothing, False) Dim pDatastat As IDataStatistics Set pDatastat = New DataStatistics pDatastat.Field = "FAC_IDFR" Set pDatastat.Cursor = pCursor Dim pEnumVar As IEnumVariantSimple Dim value As Variant 'Dim pField As IField Dim ii As Integer Set pEnumVar = pDatastat.UniqueValues value = pEnumVar.Next Do Until IsEmpty(value) 'Debug.Print value For ii = 0 To pCVDomain.CodeCount - 1 If pCVDomain.value(ii) = value Then ufrm.lstUniqueValue.AddItem pCVDomain.value(ii) & "," & pCVDomain.Name(ii) End If Next 'ufrm.lstUniqueValue.AddItem value value = pEnumVar.Next Loop ufrm.Show End Sub
コード値ドメインの利用
2016/9/1 (木)