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 |