ArcFM Engine Developer Guide
RatedKvaValidationRule.vb

Resource Center Home

Validation Rule Developer Sample (VB.NET)

RatedKvaValidationRule.vb

 


Copy Code
'========================================================================
'Copyright © 2005 Schneider Electric
'All rights reserved.
'========================================================================
'Original author: Rich Ruh
'$Author: Richr $
'$Workfile: RatedKvaValidationRule.vb $
'$Date: 4/01/05 3:53p $
'$Revision: 1 $

Imports System.Runtime.InteropServices
Imports stdole
Imports Esri.ArcGIS.Geodatabase
Imports Miner.Interop
Imports Miner.ComCategories

Namespace Miner.Samples.VBNet
    <ComponentCategory(ComCategory.MMValidationRules), _
    ProgId("MMSamples.VBNetRatedKvaValidationRule"), _
    GuidAttribute("25ddc2e7-b438-487c-9ca2-c1b2551fc021"), _
    ComVisible(True)> _
    Public Class RatedKvaValidationRule
        Inherits Miner.Samples.VBNetBaseClasses.BaseExtObject
        Implements IMMValidationRule
#Region "Constants"
        Const _TransformerModelName As String = "Transformer"
        Const _TransformerUnitModelName As String = "TransformerUnit"
        Const _KvaFieldModelName As String = "RatedKVA"
#End Region
#Region "Member Variables"
        Private _modelNameManager As IMMModelNameManager
#End Region
#Region "BaseExtObject routines"
        Public Overrides Function IsEnabled(ByVal varValues As Object) As Boolean
            IsEnabled = False
            If varValues Is Nothing Then Exit Function
            Dim objectClass As IObjectClass = varValues
            If Not objectClass Is Nothing Then
                'Only valid for classes with the "Transformer" model name
                LoadModelNameManager()
                If Not _modelNameManager Is Nothing Then
                    IsEnabled = _modelNameManager.ContainsClassModelName(objectClass, _TransformerModelName)
                End If
            End If

        End Function
        Public Overrides ReadOnly Property Name() As String
            Get
                Return "VB.NET example for RatedKVA rule"
            End Get
        End Property
#End Region
#Region "IMMValidationRule implementation"
        Public Function IsValid(ByVal pRow As Esri.ArcGIS.Geodatabase.IRow) As ID8List Implements Miner.Interop.IMMValidationRule.IsValid
            If pRow Is Nothing Then Exit Function
            LoadModelNameManager()
            If _modelNameManager Is Nothing Then Exit Function
            Dim list As ID8List
            list = New D8ListClass
            Dim obj As IObject = pRow
            If Not obj Is Nothing Then
                Dim objClass As IObjectClass
                objClass = obj.Class
                If Not _modelNameManager.ContainsClassModelName(objClass, _TransformerModelName) Then
                    Exit Function
                End If
                Dim kva As Object
                kva = GetRowValueByFieldModelName(obj, _KvaFieldModelName)
                If IsValidKvaVal(kva) Then
                    Dim relClass As IRelationshipClass
                    relClass = GetRelatedClassByModelName(objClass, esriRelRole.esriRelRoleOrigin, _TransformerUnitModelName)
                    If Not relClass Is Nothing Then
                        Dim objSet As Esri.ArcGIS.esriSystem.ISet
                        objSet = relClass.GetObjectsRelatedToObject(obj)
                        If objSet Is Nothing Then Exit Function
                        Dim relObj As IObject
                        Dim unitKva As Object
                        Dim totalUnitKva As Double
                        objSet.Reset()
                        Do
                            relObj = objSet.Next
                            If relObj Is Nothing Then Exit Do
                            unitKva = GetRowValueByFieldModelName(relObj, _KvaFieldModelName)
                            If IsValidKvaVal(unitKva) Then
                                totalUnitKva = totalUnitKva + ConvertDB2ActualKva(CDbl(unitKva))
                            End If
                        Loop
                        If totalUnitKva > 0 Then
                            If totalUnitKva <> CDbl(kva) Then
                                'Build Error string
                                Dim errorMessage As String
                                errorMessage = "Value of Rated KVA of Transformer (Rated KVA:  " & CStr(CDbl(kva)) & ") is not equal to the total Rated KVA of related Transformer Units (Rated KVA: " & totalUnitKva & ")."
                                CreateNewError(list, 8, errorMessage, 0)
                            End If
                        End If
                    End If
                End If
            End If
            IsValid = list
        End Function
#End Region
#Region "Implementation"
        Private Function GetRowValueByFieldModelName(ByVal obj As IObject, ByVal fieldModelName As String) As Object
            GetRowValueByFieldModelName = DBNull.Value
            If (obj Is Nothing Or Len(Trim(fieldModelName)) <= 0) Then Exit Function
            LoadModelNameManager()
            If _modelNameManager Is Nothing Then Exit Function
            Dim objectClass As IObjectClass
            objectClass = obj.Class
            Dim field As IField
            field = _modelNameManager.FieldFromModelName(objectClass, fieldModelName)
            If Not field Is Nothing Then
                Dim index As Long
                index = objectClass.FindField(field.Name)
                If index > -1 Then
                    GetRowValueByFieldModelName = obj.Value(index)
                End If
            End If
        End Function
        Private Shared Function IsValidKvaVal(ByVal kva As Object) As Boolean
            IsValidKvaVal = False
            If Not IsDBNull(kva) Then
                If VarType(kva) = VariantType.Double Or VarType(kva) = VariantType.Integer Then
                    IsValidKvaVal = CDbl(kva) > 0
                End If
            End If
        End Function
        Private Function GetRelatedClassByModelName(ByVal objClass As IObjectClass, ByVal relationshipRole As esriRelRole, ByVal classModelName As String) As IRelationshipClass
            If objClass Is Nothing Or Len(Trim(classModelName)) <= 0 Then Exit Function
            Dim enumRelClass As IEnumRelationshipClass
            enumRelClass = objClass.RelationshipClasses(relationshipRole)
            If Not enumRelClass Is Nothing Then
                LoadModelNameManager()
                If _modelNameManager Is Nothing Then Exit Function
                Dim relClass As IRelationshipClass
                Dim classCandidate As IObjectClass
                enumRelClass.Reset()
                Do
                    relClass = enumRelClass.Next
                    If relClass Is Nothing Then Exit Do
                    Select Case relationshipRole
                        Case esriRelRole.esriRelRoleOrigin
                            classCandidate = relClass.DestinationClass
                            If _modelNameManager.ContainsClassModelName(classCandidate, classModelName) Then
                                GetRelatedClassByModelName = relClass
                                Exit Function
                            End If
                        Case esriRelRole.esriRelRoleDestination
                            classCandidate = relClass.OriginClass
                            If _modelNameManager.ContainsClassModelName(classCandidate, classModelName) Then
                                GetRelatedClassByModelName = relClass
                                Exit Function
                            End If
                        Case esriRelRole.esriRelRoleAny
                            classCandidate = relClass.DestinationClass
                            If _modelNameManager.ContainsClassModelName(classCandidate, classModelName) Then
                                GetRelatedClassByModelName = relClass
                                Exit Function
                            Else
                                classCandidate = relClass.OriginClass
                                If _modelNameManager.ContainsClassModelName(classCandidate, classModelName) Then
                                    GetRelatedClassByModelName = relClass
                                    Exit Function
                                End If
                            End If
                        Case Else 'do nothing
                    End Select
                Loop
            End If
        End Function
        Private Shared Function ConvertDB2ActualKva(ByVal databaseKva As Double) As Double
            If databaseKva = 38 Then
                ConvertDB2ActualKva = 37.5
            Else
                ConvertDB2ActualKva = databaseKva
            End If
        End Function
        Private Shared Sub CreateNewError(ByVal list As ID8List, ByVal severity As Long, ByVal msg As String, ByVal bitMapHandle As Long)
            If list Is Nothing Then list = New D8List
            Dim theError As IMMValidationError
            theError = New MMValidationError
            With theError
                .BitmapID = bitMapHandle
                .ErrorMessage = msg
                .Severity = severity
            End With
            list.Add(theError)
        End Sub
        Private Sub LoadModelNameManager()
            If (_modelNameManager Is Nothing) Then
                Dim typeModelNameManager As System.Type
                typeModelNameManager = Type.GetTypeFromProgID("mmGeoDatabase.MMModelNameManager")
                Dim obj As Object
                obj = Activator.CreateInstance(typeModelNameManager)
                _modelNameManager = obj
            End If
        End Sub
#End Region
    End Class
End Namespace

 

 


Send Comment to ArcFMdocumentation@schneider-electric.com