Pasadena Scripts

Attribute VB_Name = "Module1"
Sub Create_Relationship()
Dim oFSO As New Scripting.FileSystemObject
Dim oFS
Dim sText As String
Set oFS = oFSO.OpenTextFile("c:\relation.TXT")
Dim myPara As Variant

Do Until oFS.AtEndOfStream
sText = oFS.ReadLine
If sText <> "" Then
myPara = Split(sText, "|")
'Debug.Print UBound(myPara)
'For i = 0 To UBound(myPara)
' Debug.Print myPara(i)
'Next
'Debug.Print
'Debug.Print sText
Create_Memory_Relation myPara(0) & "", myPara(1) & "", myPara(2) & "", myPara(3) & "", myPara(4) & "", myPara(5) & "", myPara(6) & ""
End If
Loop

End Sub




Sub Create_InMemory_Relation()


Dim pMxdoc As IMxDocument
Set pMxdoc = Application.Document
Dim pmap As IMap
Dim pStdAloneTabColl As IStandaloneTableCollection
Set pmap = pMxdoc.FocusMap
Set pStdAloneTabColl = pMxdoc.FocusMap
Dim pFeatureLayer As IFeatureLayer
Set pFeatureLayer = pmap.Layer(0)

Dim pStandaloneTable As IStandaloneTable
Dim pstd1 As IStandaloneTable
Dim pstd2 As IStandaloneTable

For i = 0 To pStdAloneTabColl.StandaloneTableCount - 1

Set pStandaloneTable = pStdAloneTabColl.StandaloneTable(i)
If pStandaloneTable.Name = "POWER.TransformerUnit" Then Set pstd1 = pStandaloneTable
If pStandaloneTable.Name = "POWER.MV_TRANSFORMERNAMEPLATE" Then Set pstd2 = pStandaloneTable

Next
Dim pMemRcFactory As IMemoryRelationshipClassFactory
Dim pMemRc As IRelationshipClass
Set pMemRcFactory = New MemoryRelationshipClassFactory

Set pMemRc = pMemRcFactory.Open("Transformer_NamePlate", pstd1.Table, "FACILITYID", pstd2.Table, _
"CITYNUM", "NamePlate", "TransformerUnit", esriRelCardinalityOneToMany)

' Add it to the layer.
Dim pRelClassCollEdit As IRelationshipClassCollectionEdit
Set pRelClassCollEdit = pstd1
pRelClassCollEdit.AddRelationshipClass pMemRc
End Sub


Sub testCrossSectionOrigin()
On Error GoTo ErrorHandler
Dim iCount As Integer
Dim iTotal As Integer
iCount = 0
iTotal = 0
Dim pMxdoc As IMxDocument
Set pMxdoc = ThisDocument

Dim pLayer As IFeatureLayer
Set pLayer = pMxdoc.FocusMap.Layer(1)

Dim pSelected As IEnumFeature
Set pSelected = pMxdoc.FocusMap.FeatureSelection

Dim pFeature As IFeature
Dim pfeature2 As IFeature
Set pFeature = pSelected.Next

' Walk through all selected features
Do While Not pFeature Is Nothing
' Dim lEID As Long

'lEID = pFeature.Value(pFeature.Fields.FindField("TransformerBankEID"))
'Debug.Print pFeature.Value(pFeature.Fields.FindField("OBJECTID"))
' Dim myQuery As IQueryFilter
'Set myQuery = New QueryFilter
'myQuery.WhereClause = "TransformerBankEID=" & lEID
' Dim pFtCursor As IFeatureCursor
'Set pFtCursor = pLayer.Search(myQuery, False)
'Set pfeature2 = pFtCursor.NextFeature

Dim pAnnoFeature As IAnnotationFeature
' Are we working with an annotation
If TypeOf pFeature Is IAnnotationFeature Then

Set pAnnoFeature = pFeature
Dim pPoint As IPoint
Dim pAnnoElement As IElement
Set pAnnoElement = pAnnoFeature.Annotation
If Not pAnnoElement Is Nothing Then
Dim pGeometry As IGeometry
Set pGeometry = pAnnoElement.Geometry
' Debug.Print pGeometry.GeometryType
If Not pGeometry Is Nothing Then
If pGeometry.GeometryType = esriGeometryPolyline Then
iCount = iCount + 1
End If
iTotal = iTotal + 1
End If

End If
Debug.Print iCount & "--" & iTotal

'If TypeOf pAnnoElement.Geometry Is IPoint Then
' Set pPoint = pAnnoElement.Geometry
' Debug.Print lEID & "," & pPoint.X & ", " & pPoint.Y
' End If


End If
'If TypeOf pfeature2 Is IAnnotationFeature Then

' Set pAnnoFeature = pfeature2

' Set pAnnoElement = pAnnoFeature.Annotation
'If TypeOf pAnnoElement.Geometry Is IPoint Then
' Set pPoint = pAnnoElement.Geometry
' Debug.Print pfeature2.Value(pfeature2.Fields.FindField("TransformerBankEID")) & "," & pPoint.X & ", " & pPoint.Y
'End If


'End If
Set pFeature = pSelected.Next
Loop

Exit Sub

ErrorHandler:
MsgBox "Error raised: " & Err.Description
End Sub


Sub testOrigin()
On Error GoTo ErrorHandler

Dim pMxdoc As IMxDocument
Set pMxdoc = ThisDocument

Dim pSelected As IEnumFeature
Set pSelected = pMxdoc.FocusMap.FeatureSelection

Dim pFeature As IFeature
Set pFeature = pSelected.Next

' Walk through all selected features
Do While Not pFeature Is Nothing

Dim pAnnoFeature As IAnnotationFeature
' Are we working with an annotation
If TypeOf pFeature Is IAnnotationFeature Then

Set pAnnoFeature = pFeature

Dim pAnnoElement As IElement
Set pAnnoElement = pAnnoFeature.Annotation

Dim pGroupElement As IGroupElement

If TypeOf pAnnoElement Is IGroupElement Then
Set pGroupElement = pAnnoElement

Dim pOrigElement As IElement
Set pOrigElement = pGroupElement.Element(0)

If TypeOf pOrigElement.Geometry Is IPoint Then ' this should be the line that fails
MsgBox "Found Cross Section Origin point"
Exit Sub
Else
MsgBox "Cross Section Origin not found, but no error raised"
Exit Sub
End If

End If
End If

Set pFeature = pSelected.Next
Loop

Exit Sub

ErrorHandler:
MsgBox "Error raised: " & Err.Description
End Sub


Sub Create_Memory_Relation(ByRef layerName As String, ByRef tableName As String, ByRef strPriKey As String, ByRef strFornKey As String, ByRef strRelName As String, strForward As String, ByRef strBackward As String)
Dim pMxdoc As IMxDocument
Set pMxdoc = Application.Document
Dim pmap As IMap
Dim pStdAloneTabColl As IStandaloneTableCollection
Set pmap = pMxdoc.FocusMap
Set pStdAloneTabColl = pMxdoc.FocusMap
Dim pid As New UID

Dim pFeatureLayer As IFeatureLayer
Dim pLayer As ILayer
Dim pEnumLayer As IEnumLayer
pid = "{40A9E885-5533-11d0-98BE-00805F7CED21}" 'IFeatureLayer
Set pEnumLayer = pmap.Layers(pid, True)
pEnumLayer.Reset
Set pLayer = pEnumLayer.Next
Do While Not pLayer Is Nothing
If UCase(pLayer.Name) = UCase(layerName) Then
Set pFeatureLayer = pLayer
Exit Do
End If
Set pLayer = pEnumLayer.Next

Loop

If pFeatureLayer Is Nothing Then
Debug.Print layerName & "layer not found"
Exit Sub
End If
Dim pStandaloneTable As IStandaloneTable

Dim bFound As Boolean
bFound = False
For i = 0 To pStdAloneTabColl.StandaloneTableCount - 1
Set pStandaloneTable = pStdAloneTabColl.StandaloneTable(i)
'Debug.Print pStandaloneTable.Name
If UCase(pStandaloneTable.Name) = UCase(tableName) Then
bFound = True
Exit For
End If

Next

If bFound = False Then
Debug.Print tableName & " table not found"
Exit Sub
End If

Dim pMemRcFactory As IMemoryRelationshipClassFactory
Dim pMemRc As IRelationshipClass
Set pMemRcFactory = New MemoryRelationshipClassFactory
On Err GoTo errhandler
Set pMemRc = pMemRcFactory.Open(strRelName, pFeatureLayer.FeatureClass, strPriKey, pStandaloneTable.Table, _
strFornKey, strForward, strBackward, esriRelCardinalityOneToMany)

' Add it to the layer.
Dim pRelClassCollEdit As IRelationshipClassCollectionEdit
Set pRelClassCollEdit = pFeatureLayer
If Not pMemRc Is Nothing Then
pRelClassCollEdit.AddRelationshipClass pMemRc
End If
Exit Sub
errhandler:
Debug.Print Err.Number & Err.Description
End Sub



Sub CleanUp_Layer()
Dim pMxdoc As IMxDocument
Set pMxdoc = Application.Document
Dim pmap As IMap
Dim pStdAloneTabColl As IStandaloneTableCollection
Set pmap = pMxdoc.FocusMap
Set pStdAloneTabColl = pMxdoc.FocusMap
Dim pid As New UID

Dim pFeatureLayer As IFeatureLayer
Dim pLayer As ILayer
Dim pEnumLayer As IEnumLayer
pid = "{40A9E885-5533-11d0-98BE-00805F7CED21}" 'IFeatureLayer
Set pEnumLayer = pmap.Layers(pid, True)
pEnumLayer.Reset
Set pLayer = pEnumLayer.Next
Dim bDelete As Boolean
bDelete = False

Do While Not pLayer Is Nothing
Set pFeatureLayer = pLayer
Dim pRelColl As IRelationshipClassCollection
Set pRelColl = pFeatureLayer
Dim pEnumRel As IEnumRelationshipClass
Set pEnumRel = pRelColl.RelationshipClasses
pEnumRel.Reset
Dim pRelClass As IRelationshipClass

Set pRelClass = pEnumRel.Next
Do While Not pRelClass Is Nothing
If Not pRelClass.DestinationClass Is Nothing Then
If InStr(pRelClass.DestinationClass.AliasName, "ML_") Or InStr(pRelClass.DestinationClass.AliasName, "MV_") Then
'Debug.Print pFeatureLayer.Name & "-->" & pRelClass.DestinationClass.AliasName
Debug.Print pRelClass.OriginClass.AliasName & "|" & pRelClass.DestinationClass.AliasName & "|" & pRelClass.OriginPrimaryKey & "|" & pRelClass.OriginForeignKey & "|" & "Name" & "|" & pRelClass.ForwardPathLabel & "|" & pRelClass.BackwardPathLabel
If bDelete = True Then
Dim pRelClassCollEdit As IRelationshipClassCollectionEdit
Set pRelClassCollEdit = pFeatureLayer
pRelClassCollEdit.RemoveRelationshipClass pRelClass
End If
End If

End If
Set pRelClass = pEnumRel.Next
Loop
Set pLayer = pEnumLayer.Next

Loop


Set pmap = pMxdoc.FocusMap
Set pStdAloneTabColl = pMxdoc.FocusMap


bDelete = False
Dim pStandaloneTable As IStandaloneTable

For j = 0 To pStdAloneTabColl.StandaloneTableCount - 1

Set pStandaloneTable = pStdAloneTabColl.StandaloneTable(j)
Set pRelColl = pStandaloneTable
Set pEnumRel = pRelColl.RelationshipClasses
Set pRelClass = pEnumRel.Next
Do While Not pRelClass Is Nothing
If Not pRelClass.DestinationClass Is Nothing Then
If InStr(pRelClass.DestinationClass.AliasName, "ML_") Or InStr(pRelClass.DestinationClass.AliasName, "MV_") Then
'Debug.Print pFeatureLayer.Name & "-->" & pRelClass.DestinationClass.AliasName
Debug.Print pRelClass.OriginClass.AliasName & "|" & pRelClass.DestinationClass.AliasName & "|" & pRelClass.OriginPrimaryKey & "|" & pRelClass.OriginForeignKey & "|" & "Name" & "|" & pRelClass.ForwardPathLabel & "|" & pRelClass.BackwardPathLabel
If bDelete = True Then
Set pRelClassCollEdit = pStandaloneTable
pRelClassCollEdit.RemoveRelationshipClass pRelClass
End If

End If
End If
Set pRelClass = pEnumRel.Next
Loop
Next



End Sub


Sub TestSrc()
Dim pmxdocument As IMxDocument
Dim pmap As IMap
Dim pEnumLayer As IEnumLayer
Dim pLayer As ILayer
Dim pftLayer As IGeoFeatureLayer
Dim pid As New UID
Dim pDatasetName As IDatasetName
Dim pwkName As IWorkspaceName
Dim pDataset As IDataset
Set pmxdocument = Application.Document
Set pmap = pmxdocument.FocusMap
pid = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}"
Set pEnumLayer = pmap.Layers(pid, True)
pEnumLayer.Reset
Dim Names(9) As Variant
Dim Values(9) As Variant

Set pLayer = pEnumLayer.Next
Do While Not pLayer Is Nothing
Set pftLayer = pLayer
Set pDataset = pftLayer.FeatureClass
Set pDatasetName = pDataset.FullName
Debug.Print pDatasetName.Name
Dim varNames As Variant, varValues As Variant
Dim pPropertySet As IPropertySet
Set pPropertySet = pDataset.PropertySet
pPropertySet.GetAllProperties varNames, varValues
Dim i As Long
For i = 0 To pPropertySet.count - 1
Debug.Print varNames(i) & " = " & varValues(i)
Next

Set pwkName = pDatasetName.WorkspaceName
' Dim pPropertySet As IPropertySet
'Set pPropertySet = pwkName.ConnectionProperties



' pPropertySet.GetAllProperties varNames, varValues
' Dim i As Long
' For i = 0 To pPropertySet.Count - 1
' Debug.Print varNames(i) & " = " & varValues(i)
' Next




' Debug.Print pwkName.PathName
' Debug.Print pwkName.BrowseName
Set pLayer = pEnumLayer.Next
Loop





End Sub



Sub FindRelatedRecord()

On Err GoTo errhandler

'hook the current map
Dim pDoc As IMxDocument
Dim pmap As IStandaloneTableCollection
Dim pMapView As IMap
Dim pStdAloneTbl As IStandaloneTable
Dim pTableSel As ITableSelection
Dim pQueryFilt As IQueryFilter
Dim pSelSet As ISelectionSet

Set pDoc = Application.Document
Set pmap = pDoc.FocusMap
Set pMapView = pDoc.FocusMap
Open "C:\Easements.txt" For Output As #1
For i = 0 To pmap.StandaloneTableCount - 1
Set pStdAloneTbl = pmap.StandaloneTable(i)
If pStdAloneTbl.Name = "WATER.WATTACHMENT" Then Exit For
Next i
Set pTableSel = pStdAloneTbl
Dim pTable As ITable
Set pTable = pStdAloneTbl
Dim pdisTable As IDisplayTable
Set pdisTable = pTable


Dim pEnumRelClass As IEnumRelationshipClass
Dim pRelClass As IRelationshipClass

Dim pObjectClass As IObjectClass
Dim pDSet As IDataset
Set pObjectClass = pdisTable.DisplayTable
Set pEnumRelClass = pObjectClass.RelationshipClasses(esriRelRoleAny)
Set pRelClass = pEnumRelClass.Next
Do While Not pRelClass Is Nothing
Set pDSet = pRelClass
If pDSet.Name = "WATER.WEasement_Has_WAttachment" Then Exit Do
Set pRelClass = pEnumRelClass.Next
Loop





Set pQueryFilt = New QueryFilter
pQueryFilt.WhereClause = "FilePath like '%Easement%'"

' Perform the selection
pTableSel.SelectRows pQueryFilt, esriSelectionResultNew, False

' Report how many rows were selected
Set pSelSet = pTableSel.SelectionSet
Dim pEnumID As IEnumIDs
Set pEnumID = pSelSet.IDs
'Debug.Print pSelSet.count & " rows selected in " & pStdAloneTbl.Name
Dim pRow As IRow
Dim pDesRow As IRow
Dim pOutSet As ISet



pEnumID.Reset
Dim ID As Long
ID = pEnumID.Next
Dim count As Long
count = 1

Dim pEditor As IEditor
Dim pid As New UID
pid = "esriCore.Editor"
Set pEditor = Application.FindExtensionByCLSID(pid)
Dim pFtClass As IFeatureClass
Dim pftLayer As IFeatureLayer
Set pftLayer = pMapView.Layer(0)
Set pFtClass = pftLayer.FeatureClass


Do While Not ID = -1

Set pRow = pTable.GetRow(ID)
'Debug.Print pRow.Value(1)
output = count & "," & pRow.Value(1)
Set pOutSet = pRelClass.GetObjectsRelatedToObject(pRow)
Dim pfields As IFields

'pEditor.StartEditing pFtClass.FeatureDataset.Workspace
If pOutSet.count <> 0 Then
Set pDesRow = pOutSet.Next

Do While Not pDesRow Is Nothing

Set pfields = pDesRow.Fields
Write #1, pDesRow.Value(pfields.FindField("OBJECTID")) & "|" & pRow.Value(1)
'pDesRow.Value(pfields.FindField("EasementBookNumber")) = pRow.Value(1) & ""
'pDesRow.Store

Set pDesRow = pOutSet.Next
Loop

End If
'pEditor.StopEditing True
ID = pEnumID.Next
Loop

Debug.Print "completed"
Close #1
Exit Sub
errhandler:
MsgBox Err.Description & "-Num" & Err.Number

End Sub

Sub FindRelatedRecord2()


'hook the current map
Dim pDoc As IMxDocument
Dim pmap As IStandaloneTableCollection
Dim pMapView As IMap
Dim pStdAloneTbl As IStandaloneTable
Dim pTableSel As ITableSelection
Dim pQueryFilt As IQueryFilter
Dim pSelSet As ISelectionSet

Set pDoc = Application.Document
Set pmap = pDoc.FocusMap
Set pMapView = pDoc.FocusMap

For i = 0 To pmap.StandaloneTableCount - 1
Set pStdAloneTbl = pmap.StandaloneTable(i)
If pStdAloneTbl.Name = "WATER.WATTACHMENT" Then Exit For
Next i
Set pTableSel = pStdAloneTbl
Dim pTable As ITable
Set pTable = pStdAloneTbl
Dim pdisTable As IDisplayTable
Set pdisTable = pTable


Dim pEnumRelClass As IEnumRelationshipClass
Dim pRelClass As IRelationshipClass

Dim pObjectClass As IObjectClass
Dim pDSet As IDataset
Set pObjectClass = pdisTable.DisplayTable
Set pEnumRelClass = pObjectClass.RelationshipClasses(esriRelRoleAny)
Set pRelClass = pEnumRelClass.Next
Do While Not pRelClass Is Nothing
Set pDSet = pRelClass
If pDSet.Name = "WATER.WEasement_Has_WAttachment" Then Exit Do
'Debug.Print pDSet.Name
Set pRelClass = pEnumRelClass.Next
Loop





Set pQueryFilt = New QueryFilter
pQueryFilt.WhereClause = "FilePath like '%Easements%'"

' Perform the selection
pTableSel.SelectRows pQueryFilt, esriSelectionResultNew, False

' Report how many rows were selected
Set pSelSet = pTableSel.SelectionSet
Dim pEnumID As IEnumIDs
Set pEnumID = pSelSet.IDs
'Debug.Print pSelSet.count & " rows selected in " & pStdAloneTbl.Name
Dim pRow As IRow
Dim pDesRow As IRow
Dim pOutSet As ISet



pEnumID.Reset
Dim ID As Long
ID = pEnumID.Next
Dim count As Long
count = 1
Dim output As String
Open "C:\Easements.txt" For Output As #1

Do While Not ID = -1

Set pRow = pTable.GetRow(ID)
'Debug.Print pRow.Value(1)
output = count & "," & pRow.Value(1)
Set pOutSet = pRelClass.GetObjectsRelatedToObject(pRow)
Dim pfields As IFields

If pOutSet.count <> 0 Then
Set pDesRow = pOutSet.Next
Set pfields = pDesRow.Fields
output = output & "," & pDesRow.Value(pfields.FindField("DistrictMap"))
output = output & "," & pDesRow.Value(pfields.FindField("FacilityID"))
output = output & "," & pDesRow.Value(pfields.FindField("Description"))
' output = output & "," & pDesRow.Value(pfields.FindField("PWP_FILENUMBER"))
' output = output & "," & pDesRow.Value(pfields.FindField("PWP_SERVICENUMBER"))
' output = output & "," & pDesRow.Value(pfields.FindField("BUILDINGNUMBER")) & " " & pDesRow.Value(pfields.FindField("STREETNAME")) & " " & pDesRow.Value(pfields.FindField("STREETTYPE"))
Debug.Print output
Write #1, output
count = count + 1


' Debug.Print pRow.Value(1) & "," & pDesRow.Value(pfields.FindField("DistrictMap")) & "," & pDesRow.Value(4) & "," & pDesRow.Value(7) & "," & pDesRow.Value(13) & "," & pDesRow.Value(26) & "," & pDesRow.Value(30) & " " & pDesRow.Value(31) & "," & pDesRow.Value(40)

End If

ID = pEnumID.Next
Loop

Debug.Print "completed"
Close #1

End Sub

Sub dump()

'Get the set of the selected rows
Dim pInSet As ISet
Dim pCursor As ICursor
Dim pRow As IRow
Set pInSet = New esriSystem.Set
pFrSelSet.Search Nothing, False, pCursor
Set pRow = pCursor.NextRow
Do While Not pRow Is Nothing
pInSet.Add pRow
Set pRow = pCursor.NextRow
Loop
pInSet.Reset

'find the selected relationship class in the map
Dim pRCColl As esriCarto.IRelationshipClassCollection
Dim pEnumRel As esriGeoDatabase.IEnumRelationshipClass
Dim pRelClass As esriGeoDatabase.IRelationshipClass
Dim pDSet As esriGeoDatabase.IDataset
Set pRCColl = pmap
Set pEnumRel = pRCColl.FindRelationshipClasses(pFromDispTab.DisplayTable, esriRelRoleAny)
Dim FoundRelClass As Boolean
FoundRelClass = False
If Not pEnumRel Is Nothing Then
Set pRelClass = pEnumRel.Next
Do While Not pRelClass Is Nothing
Set pDSet = pRelClass
If pDSet.Name = strRelateName Then 'hit the correct relate
FoundRelClass = True
Exit Do
End If
Set pRelClass = pEnumRel.Next
Loop
End If

'if selected relationship class was not found in the map,
'then look for it in a geodatabase
If Not FoundRelClass = True Then
Dim pEnumRelClass As esriGeoDatabase.IEnumRelationshipClass
Dim pObjectClass As esriGeoDatabase.IObjectClass
Set pObjectClass = pFromDispTab.DisplayTable
Set pEnumRelClass = pObjectClass.RelationshipClasses(esriRelRoleAny)
Set pRelClass = pEnumRelClass.Next
Do While Not pRelClass Is Nothing
Set pDSet = pRelClass
If pDSet.Name = strRelateName Then 'hit the correct relate
FoundRelClass = True
Exit Do
End If
Set pRelClass = pEnumRelClass.Next
Loop
End If

'if the relationship was still not found, then give up
If Not FoundRelClass = True Then
MsgBox "The relationship class was not found"
Set GetRelSelection = Nothing
Exit Sub
End If

' Get the set of related rows and build an OID list
Dim pOutSet As esriSystem.ISet
Dim pOIDList() As Long
Dim intOIDIndex As Integer
Dim intCount As Integer
Set pOutSet = pRelClass.GetObjectsRelatedToObjectSet(pInSet)
If pOutSet.count <> 0 Then
Set pRow = pOutSet.Next
Re Dim pOIDList(pOutSet.count - 1)
intOIDIndex = pRow.Fields.FindField(pToDispTab.DisplayTable.OIDFieldName)
intCount = 0
Do While Not pRow Is Nothing
pOIDList(intCount) = pRow.Value(intOIDIndex)
Set pRow = pOutSet.Next
intCount = intCount + 1
Loop
End If

' make a selectionset and add the OID's from the OID list
Dim pOutSelSet As esriGeoDatabase.ISelectionSet
Dim lngOID As Long
Set pOutSelSet = pToDispTab.DisplayTable.Select(Nothing, esriSelectionTypeHybrid, _
esriSelectionOptionEmpty, Nothing)
If pOutSet.count <> 0 Then
For lngOID = 0 To pOutSet.count - 1
pOutSelSet.Add (pOIDList(lngOID))
Next
End If

Set GetRelSelection = pOutSelSet

End Sub

Sub FindRelatedRecordWorkOrder()


'hook the current map
Dim pDoc As IMxDocument
Dim pmap As IStandaloneTableCollection
Dim pMapView As IMap
Dim pStdAloneTbl As IStandaloneTable
Dim pTableSel As ITableSelection
Dim pQueryFilt As IQueryFilter
Dim pSelSet As ISelectionSet

Set pDoc = Application.Document
Set pmap = pDoc.FocusMap
Set pMapView = pDoc.FocusMap

For i = 0 To pmap.StandaloneTableCount - 1
Set pStdAloneTbl = pmap.StandaloneTable(i)
If pStdAloneTbl.Name = "WATER.WATTACHMENT" Then Exit For
Next i
Set pTableSel = pStdAloneTbl
Dim pTable As ITable
Set pTable = pStdAloneTbl
Dim pdisTable As IDisplayTable
Set pdisTable = pTable


Dim pEnumRelClass As IEnumRelationshipClass
Dim pRelClass As IRelationshipClass

Dim pObjectClass As IObjectClass
Dim pDSet As IDataset
Set pObjectClass = pdisTable.DisplayTable
Set pEnumRelClass = pObjectClass.RelationshipClasses(esriRelRoleAny)
Set pRelClass = pEnumRelClass.Next
Do While Not pRelClass Is Nothing
Set pDSet = pRelClass
If pDSet.Name = "WATER.WGravityMain_Has_WAttachment" Then Exit Do
Debug.Print pDSet.Name
Set pRelClass = pEnumRelClass.Next
Loop





Set pQueryFilt = New QueryFilter
pQueryFilt.WhereClause = "FilePath like '%WorkOrders%'"

' Perform the selection
pTableSel.SelectRows pQueryFilt, esriSelectionResultNew, False

' Report how many rows were selected
Set pSelSet = pTableSel.SelectionSet
Dim pEnumID As IEnumIDs
Set pEnumID = pSelSet.IDs
'Debug.Print pSelSet.count & " rows selected in " & pStdAloneTbl.Name
Dim pRow As IRow
Dim pDesRow As IRow
Dim pOutSet As ISet



pEnumID.Reset
Dim ID As Long
ID = pEnumID.Next
Dim count As Long
count = 1
Dim output As String
Open "C:\GravityWorkOrders.txt" For Output As #1

Do While Not ID = -1

Set pRow = pTable.GetRow(ID)
'Debug.Print pRow.Value(1)
output = count & "," & pRow.Value(1)
Set pOutSet = pRelClass.GetObjectsRelatedToObject(pRow)
Dim pfields As IFields

If pOutSet.count <> 0 Then
Set pDesRow = pOutSet.Next
Set pfields = pDesRow.Fields
output = output & "," & pDesRow.Value(pfields.FindField("DistrictMap"))
output = output & "," & pDesRow.Value(pfields.FindField("InstallDate"))
output = output & "," & pDesRow.Value(pfields.FindField("WorkOrderID"))
output = output & "," & pDesRow.Value(pfields.FindField("PWP_FILENUMBER"))
' output = output & "," & pDesRow.Value(pfields.FindField("LiningWorkOrderID"))
output = output & "," & pDesRow.Value(pfields.FindField("Loc_OFFSET")) '& " " & pDesRow.Value(pfields.FindField("LOC_STREETNAME")) & " " & pDesRow.Value(pfields.FindField("LOC_STREETTYPE"))
Debug.Print output
Write #1, output

count = count + 1

' Debug.Print pRow.Value(1) & "," & pDesRow.Value(pfields.FindField("DistrictMap")) & "," & pDesRow.Value(4) & "," & pDesRow.Value(7) & "," & pDesRow.Value(13) & "," & pDesRow.Value(26) & "," & pDesRow.Value(30) & " " & pDesRow.Value(31) & "," & pDesRow.Value(40)

End If

ID = pEnumID.Next
Loop

Debug.Print "completed"
Close #1

End Sub


Sub Copy_Attribute()
Dim pMxdoc As IMxDocument
Dim pmap As IMap
Set pMxdoc = Application.Document
Set pmap = pMxdoc.FocusMap

Dim pLayer1 As IGeoFeatureLayer
Set pLayer1 = pmap.Layer(0)

Dim pTabColl As IStandaloneTableCollection

Dim pTable As ITable

Set pTabColl = pmap
Set pTable = pTabColl.StandaloneTable(0)

Dim pQuery As IQueryFilter
Set pQuery = New QueryFilter
pQuery.WhereClause = "1=1"

Dim pCursor As ICursor
Set pCursor = pTable.Search(pQuery, True)

Dim pRow As IRow
Set pRow = pCursor.NextRow
Dim pIDset As ISet

Dim pEditor As IEditor
Dim pid As New UID
pid = "esriEditor.Editor"
Set pEditor = Application.FindExtensionByCLSID(pid)

pEditor.StartEditing pLayer1.FeatureClass.FeatureDataset.Workspace
Dim iCount As Long
iCount = 1
Dim pFeat As IFeature
pEditor.StartOperation
Do While Not pRow Is Nothing

Set pFeat = pLayer1.FeatureClass.GetFeature(pRow.Value(pRow.Fields.FindField("ID")))
'For i = 0 To pFeat.Fields.FieldCount - 1
' Debug.Print pFeat.Fields.Field(i).Name
'Next
If Not pFeat Is Nothing Then
pFeat.Value(pFeat.Fields.FindField("UGMAPFILENUMBER")) = pRow.Value(pRow.Fields.FindField("UGFileName"))
pFeat.Store
Set pRow = pCursor.NextRow
Else
Debug.Print pRow.Value(pRow.Fields.FindField("ID")) & " not found"
End If
Debug.Print iCount
iCount = iCount + 1

Loop
pEditor.StopOperation "Finished"

pEditor.StopEditing True


End Sub



Public Type RelationShipDef
Name As String
OriginTable As String
DestTable As String
OriginKey As String
DestKey As String
End Type

Sub Create_InMemory_Relation_New()
'There are five table to table relationships defined in the Arrary
Dim myRel(5) As RelationShipDef

MyRel(1).Name = "Meter"

MyRel(1).OriginTable = "POWER.PREMISE"

MyRel(1).DestTable = "POWER.MV_E_PREMACCTMETERAC"

MyRel(1).OriginKey = "PREMISEID"

MyRel(1).DestKey = "PREMISE"

MyRel(2).Name = "6MONTH Usage"

MyRel(2).OriginTable = "POWER.PREMISE"

MyRel(2).DestTable = "POWER.MV_E_USAGE6MONTH"

MyRel(2).OriginKey = "PREMISEID"

MyRel(2).DestKey = "PREMISE"

MyRel(3).Name = "ALLPREMISES"

MyRel(3).OriginTable = "POWER.PREMISE"

MyRel(3).DestTable = "POWER.MV_E_ALLPREMISES"

MyRel(3).OriginKey = "PREMISEID"

MyRel(3).DestKey = "PREMISE"

MyRel(4).Name = "TRANSFORMERNAMEPLATE"

MyRel(4).OriginTable = "POWER.TRANSFORMERUNIT"

MyRel(4).DestTable = "POWER.MV_TRANSFORMERNAMEPLATE"

MyRel(4).OriginKey = "FACILITYID"

MyRel(4).DestKey = "CITYNUM"

MyRel(5).Name = "TRANSFORMERTESTLIST"

MyRel(5).OriginTable = "POWER.TRANSFORMERUNIT"

MyRel(5).DestTable = "POWER.MV_TRANSFORMERTESTLIST"

MyRel(5).OriginKey = "FACILITYID"

MyRel(5).DestKey = "CITYNUM"


Dim pMxdoc As IMxDocument
Dim pmap As IMap
Dim pStdAloneTabColl As IStandaloneTableCollection
'Get current standalone table collection
Set pmap = pMxdoc.FocusMap
Set pMxdoc = Application.Document
Set pStdAloneTabColl = pMxdoc.FocusMap
'Define and Prepare In Memory Relationship
Dim pStandaloneTable As IStandaloneTable
Dim pstd1 As IStandaloneTable
Dim pstd2 As IStandaloneTable
Dim pMemRcFactory As IMemoryRelationshipClassFactory
Dim pMemRc As IRelationshipClass
Set pMemRcFactory = New MemoryRelationshipClassFactory
'Iterate through the five relationships
For i = 1 To 5
'Iterate through all standalone tables to find our target tables
For j = 0 To pStdAloneTabColl.StandaloneTableCount - 1
Set pStandaloneTable = pStdAloneTabColl.StandaloneTable(j)
If UCase(pStandaloneTable.Name) = UCase(myRel(i).OriginTable) Then Set pstd1 = pStandaloneTable
If UCase(pStandaloneTable.Name) = UCase(myRel(i).DestTable) Then Set pstd2 = pStandaloneTable
Next
'make sure we find the tables to be linked
If Not pstd1 Is Nothing And Not pstd2 Is Nothing Then
'Create inMemory relationship
Set pMemRc = pMemRcFactory.Open(myRel(i).Name, pstd1.Table, myRel(i).OriginKey, pstd2.Table, myRel(i).DestKey, myRel(i).DestTable, myRel(i).OriginTable, esriRelCardinalityOneToMany)
' Add it to the table.
Dim pRelClassCollEdit As IRelationshipClassCollectionEdit
Set pRelClassCollEdit = pstd1
pRelClassCollEdit.AddRelationshipClass pMemRc
End If
Next
End Sub


Private Sub IDataLayerExample()
' prints out path, feature dataset, and feature class/dataset name
Dim pMxdoc As IMxDocument
Dim pApp As IApplication
Set pApp = Application
Set pMxdoc = pApp.Document
Dim pLayer As IDataLayer2
Dim pDataLayer As IDataLayer
Dim pDatasetName As IDatasetName
Dim pWSName As IWorkspaceName
Dim pOriginWSName As IWorkspaceName
Dim sFDS As String
Dim pFCName As IFeatureClassName
Dim i As Integer
Dim pmap As IMap
Dim pEnumLayer As IEnumLayer
Set pmap = pMxdoc.FocusMap
Dim pid As New UID
i = 0
pid = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" 'all data layer
Set pEnumLayer = pmap.Layers(pid, True)
pEnumLayer.Reset
Set pLayer = pEnumLayer.Next
Do While Not pLayer Is Nothing
i = i + 1
sFDS = ""

Set pDatasetName = pLayer.DataSourceName
Set pWSName = pDatasetName.WorkspaceName

If TypeOf pDatasetName Is IFeatureClassName Then
Set pFCName = pDatasetName
If Not pFCName.FeatureDatasetName Is Nothing Then
sFDS = pFCName.FeatureDatasetName.Name
End If
End If ' output results to the VB or VBA Immediate window
If pWSName.PathName <> "" And pOriginWSName Is Nothing Then
Set pOriginWSName = pWSName
Exit Do
End If

If pWSName.PathName = "C:\Documents and Settings\jzhou\Application Data\ESRI\ArcCatalog\Connection to GISPROD as power.sde" Then
'pWSName.ConnectionProperties.GetAllProperties
Debug.Print "(" + Format(i) + ") Path: " + pWSName.PathName
'pLayer.Disconnect
'pDatasetName.WorkspaceName.ConnectionProperties.SetProperty "SERVER", "GISPROD"
'pLayer.Connect pDatasetName
Debug.Print "Feature Dataset: " + sFDS
Debug.Print "Feature Class/Dataset: " + pDatasetName.Name
Debug.Print
pLayer.Disconnect
Set pDatasetName.WorkspaceName = pOriginWSName
pLayer.Connect pDatasetName
End If
Set pLayer = pEnumLayer.Next

Loop



Dim pTabCollection As IStandaloneTableCollection
Dim pStTable As IStandaloneTable

Dim pNewTable As ITable
Set pTabCollection = pmap
For i = 0 To pTabCollection.StandaloneTableCount - 1
'MsgBox pTabCollection.StandaloneTable(i).Name
If UCase(pTabCollection.StandaloneTable(i).Name) = UCase("POWER.SwitchUnit") Then
Set pStTable = pTabCollection.StandaloneTable(i)
End If
Next

'Open the SQL Server Workspace Factory
'Set pWSF2 = New SdeWorkspaceFactory
'Set pWS = pWSF2.OpenFromString(pOriginWSName.ConnectionProperties, 0)
Dim pFeatureWS As IFeatureWorkspace
Set pFeatureWS = pOriginWSName.WorkspaceFactory


Set pNewTable = pFeatureWS.OpenTable("POWER.SwitchUnit")

'Change FeatureClass of layer
Dim pMapAdmin2 As IMapAdmin2
Set pMapAdmin2 = pmap
pMapAdmin2.FireChangeTable pStTable.Table, pNewTable

Dim pActiveView As IActiveView
Set pActiveView = pmap
pActiveView.Refresh

pMxdoc.UpdateContents
pMxdoc.ActivatedView.Refresh
End Sub