option explicit

!INC Local Scripts.EAConstants-VBScript

'
' Script 	Name: PostProcessImportedVisioArcInfoModel
' Author: 	Sparx Systems Pty Ltd
' Purpose: 	Performs clean-up steps on a model that contains the ArcInfo model template and workspace, imported from Visio.
'			The clean-up occurs in the following two stages:
'			  1. Clean-up the core Esri interfaces, classes and diagrams to make it look like it did in Visio.
'			  2. Post-process the user-defined ArcInfo Workspace model. This means reapplying the stereotypes to align with
'				 EA's ArcGIS profile and adjusting the package structure to that required by EA.
'			The goal is to facilitate generation of a valid ArcGIS schema directly from an imported Visio ArcInfo model.
'
' Assumptions:
'			- The script must be executed using Enterprise Architect 12.1, Build 1220 or later.
'			- The model must have been imported using EA's Visio importer version 1.8 or later, and Enterprise Architect 12.1, Build 1220 or later.
'			- There is only one <<Workspace>> package and only one ArcInfo model template in the EAP repository.
'			- The script is only compatible with EAP file repositories.
'			  (If using an RDBMS, execute the script on an EAP model first, then use EA's Project Transfer feature,
'			   or copy/paste the result)
'
' Known Limitations:
'	1. The following tagged values are not currently migrated:
'		ConfigKeyword (applies to Feature/Object Classes)
'		GNConfigKeyword (applies to GeometricNetworks)
'	2. Composite relationships are currently not migrated by the script, nor are they supported in EA's ArcGIS profile as of build 12.1.1220. 
'
' Date: 	09/11/2015
'

Dim idPkgs			' Maps Package Ids (EA.Package.PackageID) -> Packages (EA.Package objects)
Set idPkgs = CreateObject("Scripting.Dictionary")

Dim idClasses		' Maps Class Elements Ids (EA.Element.ElementID) -> Class Elements (EA.Element objects)
Set idClasses = CreateObject("Scripting.Dictionary")

Dim nameClasses		' Maps Class names (as a string) -> Class Element (EA.Element)
Set nameClasses = CreateObject("Scripting.Dictionary")

Dim gnIdTypes		' Maps Geometric Network Elements Ids (EA.Element.ElementID) -> Geometric Network Types (as a string)
Set gnIdTypes = CreateObject("Scripting.Dictionary")

Const vcSource = 1	' Parameter value to virtualize the connector source end in VirtualizeConnector API
Const vcTarget = 2	' Parameter value to virtualize the connector target end in VirtualizeConnector API

Sub main
	' Show the script output window
	Repository.EnsureOutputVisible "Script"

	Session.Output( "PostProcessImportedVisioArcInfoModel" )
	Session.Output( "=======================================" )

	' Make sure we're using Enterprise Architect 12.1.1220 or later
	If LibraryVersion < 1220 Then
		Session.Output "Error: This script requires Enterprise Architect version 10, Build 1007 or later. The following version was detected: " & LibraryVersion
	End If

	Session.Output("Start Time: " & Time)

	' 1. Clean up the Esri core classes, interfaces and diagrams
	CleanEsriArcInfoElements

	' 2. Clean up the rest of the model...
	CleanWorkspaceElements

	Session.Output("End Time: " & Time)

	Session.Output("ArcInfo Model Update Complete!")
	Repository.RefreshModelView(0)

End Sub

' The following operations are performed:
'	1. Find the <<Workspace>> package. Clear the stereotype and apply the stereotype <<ArcGIS>>. Delete the legacy Template* elements
'	2. Create a spatial references package, with a SpatialReference element and diagram
'	3. Link each <<FeatureDataset>> package to the SpatialReference element
'	4. Link each feature class that is not defined in a feature dataset, to the Spatial Reference element
'	5. Apply Feature Class stereotypes (eg. Point, Polyline and Polygon) to classes and set the target language to ArcGIS
'	6. Update tagged values for fields (eg. convert AllowNulls to IsNullable)
'	7. Change each diagram type to ArcGIS
'	8. Erase the spurious connector names created by Visio's XMI exporter
'   9. Convert <<Subtype>> Association links to Generalizations
'  10. Convert RelationshipClass elements that have a corresponding Association connector into UML Association Classes
'  11. Apply the tree-style connector notation to Generalizations
'  12. Delete the visio_uid tagged values
'  13. Move diagrams to packages with the same name, if such packages are found in the workspace.
'	   (The Visio Importer cannot preserve original diagram ownership.)
'  14. Convert <<GeometricNetwork>> Classes to Packages
'
Sub CleanWorkspaceElements

	Dim workspaces
	workspaces = GetPkgsByStereotype("Workspace", "")
	If UBound(workspaces) > 0 Then
		Session.Output "Error: Found more than one <<Workspace>> package in model. Aborting."
		Exit Sub
	ElseIf UBound(workspaces) < 0 Then
		Session.Output "Error: Could not find a <<Workspace>> package in model. Aborting."
		Exit Sub
	End If

	Dim workspacePkg As EA.Package
	Set workspacePkg = workspaces(0)
	If Not workspacePkg Is Nothing Then
		UpdateWorkspacePkg workspacePkg
	Else
		Session.Output "Error: Failed to load the <<Workspace>> package. Aborting."
		Exit Sub
	End If

	Dim workspacePkgIds
	workspacePkgIds = GetWorkspacePkgIds(workspacePkg)

	Dim spatialRef As EA.Element
	Set spatialRef = GetSpatialReference(workspacePkgIds, workspacePkg)

	If Not spatialRef Is Nothing Then
		Dim datasets
		datasets = ProcessFeatureDataSets(workspacePkgIds, spatialRef.ElementGUID)
		ProcessWorkspaceElements workspacePkgIds, datasets, spatialRef.ElementGUID
		SynchArcGISStereotypes

		Dim workspacePkgs
		workspacePkgs = GetWorkspacePkgs(workspacePkgIds)
		ProcessWorkspacePkgs workspacePkgs
		ProcessWorkspaceDgms workspacePkgs, workspacePkgIds
		ProcessGeometricNetworks
	Else
		Session.Output "Error: Failed to create the <<SpatialReference>> element. Aborting."
		Exit Sub
	End If

End Sub

Sub UpdateWorkspacePkg(pkg)

	If Not pkg Is Nothing Then
		Session.Output "Resetting the Workspace Package stereotype to 'ArcGIS'..."
		ApplyPkgStereotype pkg, "ArcGIS"
		RemoveTagByName pkg.Element.TaggedValues, "visio_uid"
		Session.Output VbTab & "...done"
		Session.Output "Removing legacy template elements: TemplateCodedValueDomain, TemplateGeometricNetwork, TemplateRangeDomain..."

		Dim el As EA.Element
		Dim idx
		For idx = 0 To pkg.Elements.Count - 1
			Set el = pkg.Elements.GetAt(idx)
			If el.Name = "TemplateCodedValueDomain" Or el.Name = "TemplateGeometricNetwork" Or el.Name = "TemplateRangeDomain" Then
				pkg.Elements.DeleteAt idx, false
			End If
		Next
		pkg.Elements.Refresh
		Session.Output VbTab & "...done"
	End If

End Sub

' Returns a comma separated string containing each Package ID in the workspace, include the workspace package ID itself
' workspacePkg is an EA.Package object. Corresponding to the workspace package for the schema.
Function GetWorkspacePkgIds(workspacePkg)

	Dim idsList
	idsList = ""

	If Not workspacePkg Is Nothing Then
		Dim workspacePkgIds()
		ReDim workspacePkgIds(0)
		workspacePkgIds(0) = workspacePkg.PackageID
		GetDescendantPkgs workspacePkg.PackageID, workspacePkgIds
		Dim id
		For Each id In workspacePkgIds
			idsList = idsList & id & ","
		Next
		If Len(idsList) > 1 Then
			idsList = Left(idsList, Len(idsList) - 1)
		End If
	End If

	GetWorkspacePkgIds = idsList

End Function

' Attempts to locate an existing spatial reference element within the workspace
' Creates one if none are found
' Returns the created, or the first existing, spatial reference element as an EA.Element object
Function GetSpatialReference(workspacePkgIds, workspacePkg)

	Dim sql
	sql = "SELECT t_object.Object_ID FROM t_object WHERE t_object.Object_Type='Class' AND t_object.Stereotype='SpatialReference' AND t_object.Package_ID IN (" + workspacePkgIds + ")"
	Dim el As EA.Element
	Set el = Nothing

	Dim els As EA.Collection
	Set els = GetElementSet(sql,2)

	If els.Count > 0 Then
		' Just take the first spatial reference element we come across
		Set el = els.GetAt(0)
		If els.Count > 1 Then
			Session.Output "Warning: Multiple spatial reference elements found in workspace. Using the spatial reference named: " & el.Name
		End If
	Else
		Set el = AddSpatialReference(workspacePkg)
	End If

	Set GetSpatialReference = el

End Function

Sub ProcessWorkspaceElements(workspacePkgIds, datasets, spatialRefGUID)

	Dim sql
	sql = "SELECT t_object.Object_ID FROM t_object, t_package WHERE t_object.Object_Type = 'Class' AND t_package.Package_ID = t_object.Package_ID AND t_object.Package_ID IN (" + workspacePkgIds + ") AND t_package.Name <> 'ESRI Interfaces' AND t_package.Name <> 'ESRI Classes' AND t_package.Name <> 'ESRI Network' AND t_package.Name <> 'Spatial References'"
	Dim el As EA.Element
	Dim els As EA.Collection
	Set els = GetElementSet(sql,2)

	' First we must assign the known stereotypes, based on the "GeometryType" tagged value
	Session.Output "Applying stereotypes to feature classes..."
	Dim idx
	For idx = 0 To els.Count - 1
		Set el = els.GetAt(idx)
		If Not el Is Nothing Then
			ApplyGeometryStereotype el
		End If

		' Use this loop to populate the class dictionaries as well
		idClasses.Add el.ElementID, el
		Dim elName: elName = el.Name
		If nameClasses.Exists(elName) = False Then
			Set nameClasses(elName) = el
		End If
	Next
	Session.Output VbTab & "...done"

	' We have to iterate again to try differentiate ObjectClasses from Subtypes
	For idx = 0 To els.Count - 1
		Set el = els.GetAt(idx)
		If Not el Is Nothing Then
			UpdateSubtypeRelationships el, False
		End If
	Next

	' Finally we can call ProcessElement, which assigns ObjectClass as the default stereotype and processes element internals.
	' If we rolled this into the previous loop, the default ObjectClass stereotype gets assigned too early, interfering
	' with tests for subtype vs parent element.
	For idx = 0 To els.Count - 1
		Set el = els.GetAt(idx)
		If Not el Is Nothing Then
			ProcessElement el, datasets, spatialRefGUID
		End If
	Next

	'els contains only elements in the workspace packages, others were filtered out by the sql select
	UpdateClassRelationships els, False

End Sub

Sub ApplyGeometryStereotype(el)

	Dim geomType
	geomType = GetTagValByName(el.TaggedValues, "GeometryType")
	If geomType = "esriGeometryPoint" Then
		el.StereotypeEx = "Point"
	ElseIf geomType = "esriGeometryPolyline" Then
		el.StereotypeEx = "Polyline"
	ElseIf geomType = "esriGeometryPolygon" Then
		el.StereotypeEx = "Polygon"
	ElseIf geomType = "esriGeometryMultiPoint" Then
		el.StereotypeEx = "MultiPoint"
	End If

End Sub

Sub ProcessElement(el, datasets, spatialRefGUID)
	Dim elName: elName = el.Name
	Session.Output "Processing Element: " + elName

	Dim bFeature, bRangeDomain, bCodedValueDomain, bGeometricNetwork, bTable, bRelClass, bSubtype, bAbstract, bSkip
	bFeature = False
	bRangeDomain = False
	bCodedValueDomain = False
	bGeometricNetwork = False
	bTable = False
	bRelClass = False
	bSubtype = False
	bAbstract = el.Abstract = "1"
	bSkip = False

	Dim elStereo
	elStereo = el.Stereotype

	If IsFeatureClassStereotype(elStereo) = True And bAbstract = False Then
		bFeature = True
	ElseIf elStereo = "RangeDomain" Then
		bRangeDomain = True
	ElseIf elStereo = "CodedValueDomain" Then
		bCodedValueDomain = True
	ElseIf elStereo = "GeometricNetwork" Then
		bGeometricNetwork = True
		AddGeometricNetworkID el.ElementID
	ElseIf elStereo = "RelationshipClass" Then
		bRelClass = True
	ElseIf elStereo = "ObjectClass" Then
		bTable = True
	ElseIf elStereo = "Subtype" Then
		bSubtype = True
	ElseIf Len(elStereo) = 0 Then
		' If we find an unstereotyped abstract class, don't make a Table out of it
		If bAbstract = False Then
			Session.Output VbTab & "Treating this element as a Table (ObjectClass)"
			elStereo =  "ObjectClass"
			el.StereotypeEx = "ObjectClass"
			bTable = True
		End If
	Else
		' Maybe we have an abstract feature class stereotyped element. Report it, but take no other action.
		If IsFeatureClassStereotype(elStereo) = True And bAbstract = True Then
			Session.Output VbTab & "Warning: Found a Feature Class marked as Abstract."
		Else
			Session.Output VbTab & "Warning: Unknown element type. Stereotype is: " & elStereo
		End If
		bSkip = True
	End If

	RemoveTagByName el.TaggedValues, "visio_uid"
	RemoveTagByName el.TaggedValues, "CLSID"

	If bTable = True Or bFeature = True Then
		Dim elAlias: elAlias = GetTagValByNameNoCase(el.TaggedValues, "Alias")
		If Len(elAlias) > 0 Then
			el.Alias = elAlias
			RemoveTagByNameNoCase el.TaggedValues, "Alias"
		End If
		RemoveTagByName el.TaggedValues, "GeometryType"
		' Now make sure the boolean values are lower case
		ConvertBooleanTagCase(el.TaggedValues)
		el.SynchTaggedValues "ArcGIS", elStereo ' This call also migrates any unqualified HasM and HasZ tags
		el.TaggedValues.Refresh
	ElseIf bCodedValueDomain = True Or bRangeDomain = True Then
		Dim desc: desc = GetTagValByName(el.TaggedValues,"Description")
		el.SynchTaggedValues "ArcGIS", elStereo ' This call ensures the Description tag is qualified by the ArcGIS profile
		el.TaggedValues.Refresh
		' A little workaround to ensure our original description value doesn't get wiped out
		If Len(desc) > 0 Then
			el.Update
			SetTagValByNameEx el.TaggedValues,"Description","<memo>", desc
		End If
	End If

	If bSkip = False Then
		Dim idx
		Dim att As EA.Attribute
		For idx = 0 To el.Attributes.Count - 1
			Set att = el.Attributes.GetAt(idx)
			If Not att Is Nothing Then
				Dim attName: attName = att.Name
				Session.Output VbTab & "Processing Attribute: " + attName
				' Use a case insensitive search on attribute names - as manual entry in Visio sometimes causes case variation
				attName = LCase(attName)
				If bFeature = True Or bTable = True Or bRelClass = True Then
					If LCase(att.Stereotype) = "subtypefield" Then
						If Len(att.Default) = 0 Then
							Session.Output VbTab & VbTab & "Warning: No default subtype code was specified for Feature/Object Class. Scanning subtypes to determine lowest value..."
							Dim subtypeCode
							subtypeCode = GetDefaultSubtypeCode(el)
							If subtypeCode = "-1" Then
								Session.Output VbTab & VbTab & "No subtype codes were found. Assuming a value of 1."
								att.Default = "1"
							Else
								att.Default = subtypeCode
								Session.Output VbTab & VbTab & "Found a minimum value of: " & subtypeCode & ". Assuming this as the default subtype code."
							End If
						ElseIf IsNumeric(att.Default) = False Then
							Session.Output VbTab & VbTab & "Warning: Non-numeric default subtype code value was must be was specified. Assuming a value of 1."
							att.Default = "1"
						End If
						ProcessSubtypeField att
					Else
						ProcessField att
					End If
				ElseIf bSubtype = True Then
					If LCase(att.Stereotype) <> "subtypefield" Then
						ProcessField att
					Else
						' No point migrating existing tags - they are all redundant for the subtype element.
						DeleteAllTags att.TaggedValues
					End If
				ElseIf bRangeDomain = True Then
					If attName = "fieldtype" Then
						att.Type = "esriFieldType"
						att.Update
						'att.TaggedValues.Refresh ' No tags for this stereotype - don't bother refreshing
					End If
				ElseIf bCodedValueDomain = True Then
					If attName <> "fieldtype" And attName <> "mergepolicy" And attName <> "splitpolicy" Then
						att.Type = ""
						att.StereotypeEx = "DomainCodedValue"
						att.Update
						'att.TaggedValues.Refresh ' No tags for this stereotype - don't bother refreshing
					End If
				ElseIf bGeometricNetwork = True Then
					If attName = "networktype" Then
						SetGeometricNetworkType el.ElementID, att.Default
					End If
				ElseIf bAbstract = True Then
					ConvertAllowNullsTag att
					ConvertAliasTag att
					att.TaggedValues.Refresh ' Probably redundant, but better to be safe...
				End If
			End If
		Next
	End If
	el.Gentype = "ArcGIS"
	el.Update
	' XXX Probably redundant for the feature class, table, range domain and coded value domain stereotypes
	el.TaggedValues.Refresh ' Need this call after Update, as any missing ArcGIS tags get automatically synched as of EA 10, if the stereotype changed.

	If bFeature = True Then
		ProcessNonFDSpatialRef el, datasets, spatialRefGUID
		AddRequiredFields el
		AddAttributeIndex el
		AddSpatialIndex el
	ElseIf bTable = True Then
		AddRequiredField el, elstereo, "OBJECTID", "esriFieldTypeOID"
		AddAttributeIndex el
	End If

End Sub

Function AddSpatialReference(pkg)
	Dim el As EA.Element
	Set el = Nothing
	If Not pkg Is Nothing Then
		Session.Output "Adding 'Spatial References' Package..."
		Dim srpkg As EA.Package
		Set srpkg = pkg.Packages.AddNew("Spatial References", "")
		If Not srpkg Is Nothing Then
			srpkg.Update
			Dim dgm As EA.Diagram
			Session.Output "Adding 'Spatial References' Diagram..."
			Set dgm = srpkg.Diagrams.AddNew("Spatial References", "")
			If Not dgm Is Nothing Then
				dgm.Update
				Session.Output "Adding 'Spatial References' Element: MySpatialReference"
				Set el = srpkg.Elements.AddNew("MySpatialReference", "SpatialReference")
				If Not el Is Nothing Then
					el.Update
					Dim dgmEl As EA.DiagramObject
					Set dgmEl = dgm.DiagramObjects.AddNew("","")
					If Not dgmEl Is Nothing Then
						dgmEl.ElementID = el.ElementID
						dgmEl.Update
						CustomCommand "VisioImporter", "UpdateStyle", "ID="&dgmEl.InstanceID&";style=Tag,1;"
					End If
				End If
			End If
		End If
		Session.Output VbTab & "...done"
	End If
	
	Set AddSpatialReference = el
End Function

Sub SynchArcGISStereotypes

	Session.Output "Synchronizing ArcGIS profile stereotypes with imported elements..."

	' The <<ArcGIS>> and <<FeatureDataset>> tags are added by ApplyPkgStereotype
'	Session.Output VbTab & "... Synchronizing <<Point>>"
'	SynchProfile "ArcGIS", "Point"
'	Session.Output VbTab & "... Synchronizing <<Polyline>>"
'	SynchProfile "ArcGIS", "Polyline"
'	Session.Output VbTab & "... Synchronizing <<Polygon>>"
'	SynchProfile "ArcGIS", "Polygon"
'	Session.Output VbTab & "... Synchronizing <<CodedValueDomain>>"
'	SynchProfile "ArcGIS", "CodedValueDomain"
'	Session.Output VbTab & "... Synchronizing <<RangeDomain>>"
'	SynchProfile "ArcGIS", "RangeDomain"
''	Session.Output VbTab & "... Synchronizing <<SpatialReference>>"
'	SynchProfile "ArcGIS", "SpatialReference"
	Session.Output VbTab & "... Synchronizing <<Field>>"
	SynchProfile "ArcGIS", "Field"
'	Session.Output VbTab & "... Synchronizing <<DomainCodedValue>>"
'	SynchProfile "ArcGIS", "DomainCodedValue"
	Session.Output VbTab & "... Synchronizing <<RelationshipClass>>"
	SynchProfile "ArcGIS", "RelationshipClass"
'	Session.Output VbTab & "... Synchronizing <<ObjectClass>>"
''	SynchProfile "ArcGIS", "ObjectClass"

	' The <<RequiredField>> and <<SubtypeField>> tags are added explicitly elsewhere

	' The SynchProfile call for "RelationshipClass" adds redundant tags to the AssociationClass. So Remove the lot.
	' Note: This will destroy any non-ArcGIS tags on the RelationshipClass from the Visio model as well.
	Dim els
	els = idClasses.Items
	Dim el As EA.Element
	For Each el In els
		If el.Stereotype = "RelationshipClass" Then
			' Get the tags that were created by SynchProfile
			el.TaggedValues.Refresh
			DeleteAllTags el.TaggedValues
			el.TaggedValues.Refresh
		End If
	Next

	Session.Output VbTab & "...done"

End Sub

' Returns a zero-based array of EA.Package elements that represent feature datasets in the workspace
Function ProcessFeatureDataSets(workspacePkgIds, spatialRefGuid)

	Dim datasets
	datasets = GetPkgsByStereotype("FeatureDataset", workspacePkgIds)

	If Not UBound(datasets) < 0 Then
		Session.Output "Linking Feature Datasets to a Spatial Reference element..."
		Dim pkg As EA.Package
		Dim idx
		For idx = 0 To UBound(datasets)
			Set pkg = datasets(idx)
			If Not pkg Is Nothing Then
				ApplyPkgStereotype pkg, "FeatureDataset" ' This just forces the right ArcGIS tags to be added
				Dim tag As EA.TaggedValue
				Set tag = GetTagByName(pkg.Element.TaggedValues, "SpatialReference")
				If tag Is Nothing Then
					Session.Output VbTab & "Error: Failed to set SpatialReference tag on FeatureDataset package: " & pkg.Name
				ElseIf Len(tag.Value) = 0 Then
					tag.Value = spatialRefGuid
					tag.Update
				End If
			End If
		Next
		Session.Output VbTab & "...done"
	End If

	ProcessFeatureDataSets = datasets

End Function

' Converts the GeometricNetwork stereotyped Classes (per CASE tools profile) to GeometricNetwork stereotyped Packages (per EA profile).
' Converts the NetworkType Attribute from the original GeometricNetwork Class to a NetworkType Tagged Value on the GeometricNetwork Package
' Moves all associated Feature Classes and Tables into corresponding GeometricNetwork Packages
' Deletes the original GeometricNetwork class
Sub ProcessGeometricNetworks()

	Session.Output "Processing Geometric Networks..."
	Dim id, ids, el
	ids = gnIdTypes.Keys
	For Each id In ids
		Set el = GetElByID(id)
		If Not el Is Nothing Then
			Session.Output VbTab & "Converting " & el.Name & " from a UML Class to UML Package..."
			Dim gnPkg
			Set gnPkg = AddGeometricNetworkPkg(el)
			If Not gnPkg Is Nothing Then
				MigrateGeometricNetworkType el, gnPkg
				MoveGeometricNetworksElements el, gnPkg
				DeleteGeometricNetworkElement el
			End If
			Session.Output VbTab & VbTab & "...done"
		End If
	Next
	Session.Output VbTab & "...done"

End Sub

Function AddGeometricNetworkPkg(gnEl)

	Dim fdPkg As EA.Package
	Set fdPkg = GetPkgByID(gnEl.PackageID)

	Dim gnPkg As EA.Package
	Set gnPkg = fdPkg.Packages.AddNew(gnEl.Name, "")
	If Not gnpkg Is Nothing Then
		gnPkg.Update
		ApplyPkgStereotype gnPkg, "GeometricNetwork"
	End If

	Set AddGeometricNetworkPkg = gnPkg

End Function

Sub MigrateGeometricNetworkType(el, pkg)

	Dim nType
	nType = gnIdTypes(el.ElementID)
	If Len(nType) > 0 Then
		SetTagValByName pkg.Element.TaggedValues, "NetworkType", nType
	End If

End Sub


' Iterate over all relationships owned by el (the GeometricNetwork class)
' If the relationship is an association process it, else warning
' Move the related element to gnPkg (the GeometricNetwork package)
Sub MoveGeometricNetworksElements(el, gnPkg)

	Dim cons As EA.Collection
	Set cons = el.Connectors
	Dim idxCon
	Dim con As EA.Connector
	For idxCon = 0 To cons.Count - 1
		Set con = cons.GetAt(idxCon)

		Dim endEl As EA.Element
		Set endEl = Nothing

		' Only update connectors owned by this element
		If con.ClientID = el.ElementID Then
			Set endEl = GetElByID(con.SupplierID)
		Else
			Set endEl = GetElByID(con.ClientID)
		End If

		If Not endEl Is Nothing Then
			endEl.PackageID = gnPkg.PackageID
			endEl.Update
		Else
			Session.Output VbTab & VbTab & "Error: Unable to retrieve related Feature Class of Geometric Network: " & el.Name & "with relationhip GUID: " & con.ConnectorGUID
		End	If
	Next

End Sub

Sub DeleteGeometricNetworkElement(el)

	Dim pkg as EA.Package
	Set pkg = GetPkgByID(el.PackageID)
	Session.Output VbTab & VbTab & "Deleting Original GeometricNetwork class Element..."
	If Not pkg Is Nothing Then
		Dim obj
		Dim idx
		For idx = 0 To pkg.Elements.Count - 1
			Set obj = pkg.Elements.GetAt(idx)
			If obj.ElementID = el.ElementID Then
				pkg.Elements.Delete(idx)
				pkg.Elements.Refresh
				Session.Output VbTab & VbTab & VbTab & "...done"
				Exit For
			End If
		Next
	Else
		Session.Output VbTab & VbTab & VbTab & "Error: Unable to retrieve owning Package of Geometric Network class Element..."
	End If



End Sub

Function GetWorkspacePkgs(workspacePkgIds)

	Dim aryIds
	aryIds = Split(workspacePkgIds, ",")

    Dim pkgs(), count
	count = 0
	ReDim pkgs(-1)

	Dim pkgID
	For Each pkgID In aryIds
		Dim pkg As EA.Package
		Set pkg = GetPackageByID(pkgID)
		If Not pkg Is Nothing Then
			Redim Preserve pkgs(count)
			Set pkgs(count) = pkg
			count = count + 1
			' Update the global map of workspace packages
			If idPkgs.Exists(CLng(pkgID)) = False Then
				Set idPkgs(CLng(pkgID)) = pkg
			End If
		End If
	Next

	GetWorkspacePkgs = pkgs

End Function

Sub ProcessWorkspacePkgs(workspacePkgs)

	Session.Output "Updating Workspace Packages: Removing visio_uids... "

	Dim p As EA.Package
	For Each p In workspacePkgs
		RemoveTagByName p.Element.TaggedValues, "visio_uid"
	Next

	Session.Output VbTab & "...done"

End Sub

' Sets the type of every diagram in the workspace to ArcGIS
' Hides required fields on all diagram elements
' Move diagrams to a package by the same name, if one is found in the workspace
Sub ProcessWorkspaceDgms(workspacePkgs, workspacePkgIds)

	Dim sql, aryIds
	sql = "SELECT t_diagram.Diagram_ID FROM t_diagram WHERE t_diagram.Package_ID IN (" + workspacePkgIds + ")"
	aryIds = BuildArrayFromSQL(sql,"Diagram_ID")

	Session.Output "Updating Workspace Diagrams: Changing to type 'ArcGIS' and suppressing display of RequiredFields... "
	Dim id
	Dim dgm As EA.Diagram
	For Each id In aryIds
		Set dgm = GetDiagramByID(id)
		If Not dgm Is Nothing Then
			Session.Output VbTab & "Processing diagram: " & dgm.Name & "..."
			Dim style
			style = dgm.StyleEx
			ChangeElStyle style, "MDGDgm", "ArcGIS::ArcGIS"
			dgm.StyleEx = style

			Dim p As EA.Package
			For Each p In workspacePkgs
				If p.Name = dgm.Name And Not p.PackageID = dgm.PackageID Then
					Session.Output VbTab & VbTab & "Moving diagram: " & dgm.Name & " to package: " & p.Name
					Dgm.PackageID = p.PackageID
					Exit For
				End If
			Next

			Dim idxCon
			Dim con As EA.DiagramLink
			For idxCon = 0 To dgm.DiagramLinks.Count - 1
				Set con = dgm.DiagramLinks.GetAt(idxCon)
				' Highlight all virtualized connectors
				Dim vEnd : vEnd = dgm.VirtualizedEnd(con.ConnectorID)
				If vEnd <> 0 Then
					style = con.style
					ChangeElStyle style, "Color", "255"
					ChangeElStyle style, "LWidth", "3"
					con.style = style
					con.Update
				End If
			Next

			dgm.Update
			Dim idx
			Dim obj As EA.DiagramObject
			For idx = 0 To dgm.DiagramObjects.Count - 1
				Set obj = dgm.DiagramObjects.GetAt(idx)
				If Not obj Is Nothing Then
					If Not obj Is Nothing Then
						' Could streamline this by first checking whether the element represents a feature or object class...
						' The CustomCommand currently only supports hiding a single stereotype, so use SQL update to hide multiple stereotypes.
						'CustomCommand "VisioImporter", "UpdateStyle", "ID="&obj.InstanceID&";style=HideStype,RequiredField,AttributeIndex,SpatialIndex;"
						sql = "Select ObjectStyle from t_diagramobjects where Instance_ID="&obj.InstanceID
						Dim ret: ret = Repository.SQLQuery(sql)
						style = ExtractFieldValFromXML(ret, "ObjectStyle")
						ChangeElStyle style, "HideStype", "RequiredField,AttributeIndex,SpatialIndex"
						sql = "UPDATE t_diagramobjects SET ObjectStyle='"&style&"' where Instance_ID="&obj.InstanceID
						Repository.Execute sql
					End If
				End If
			Next
		End If
	Next
	Session.Output VbTab & "...done"

End Sub

' Determines whether el belongs to a feature dataset package
' If not, then set the spatialreference tagged value to spatialRefGuid
Sub ProcessNonFDSpatialRef(el, datasets, spatialRefGuid)
	If Not el Is Nothing Then
		Dim bInFD
		bInFD = False
		Dim pkg
		For Each pkg In datasets
			If pkg.PackageID = el.PackageID Then
				bInFD = True
				Exit For
			End IF
		Next

		If bInFD = False Then
			SetTagValByNameEx el.TaggedValues, "SpatialReference", spatialRefGuid, ""
		End If
	End If
End Sub

Sub AddRequiredFields(el)
	If Not el Is Nothing Then
		Dim elStereo: elStereo = el.Stereotype

		' Add the ObjectID
		AddRequiredField el, elStereo, "OBJECTID", "esriFieldTypeOID"

		' Add the Shape Field
		AddRequiredField el, elStereo, "Shape", "esriFieldTypeGeometry"

		' Add the Shape_Length field for Polylines and Polygons
		If elStereo = "Polygon" Or elStereo = "Polyline" Then
			AddRequiredField el, elStereo, "Shape_Length", "esriFieldTypeDouble"
		End If

		If elStereo = "Polygon" Then
			AddRequiredField el, elStereo, "Shape_Area", "esriFieldTypeDouble"
		End If
	End If
End Sub

Sub AddRequiredField(el, elStereo, attName, attType)
	Dim att As EA.Attribute
	Set att = GetAttByName(el.Attributes, attName)
	If Not att Is Nothing Then
		If att.Stereotype <> "RequiredField" Then
			att.StereotypeEx = "RequiredField"
			att.Type = attType
		Else
			Session.Output VbTab & VbTab & "Error: Attribute named '"&attName&"' in element named '"&el.Name&"' already has RequiredField stereotype. Some tagged values will not be added to this attribute."
		End If
	Else
		Set att = el.Attributes.AddNew(attName, attType)
		If Not att Is Nothing Then
			el.Attributes.Refresh
			att.StereotypeEx = "ArcGIS::RequiredField"
		Else
			Session.Output VbTab & VbTab & "Error: Failed to create RequiredField named '"&attName&"' for element named '"&el.Name&"'."
		End If
	End If

	If Not att Is Nothing Then
		' The Update call saves the stereotype and adds the tags to the repository, so refresh the tags collection as well
		att.Update
		att.TaggedValues.Refresh

		If attName = "Shape" Or attName = "OBJECTID" Then
			SetTagValByName att.TaggedValues, "DomainFixed", "true"
		End If

		If attName = "OBJECTID" Or attName = "Shape_Length" Or attName = "Shape_Area" Then
			SetTagValByName att.TaggedValues, "Editable", "false"
		End If

		If attName = "OBJECTID" Then
			SetTagValByName att.TaggedValues, "IsNullable", "false"
		End If

		If attName = "OBJECTID" Then
			SetTagValByName att.TaggedValues, "Length", "4.0"
		ElseIf attName = "Shape_Length" Then
			SetTagValByName att.TaggedValues, "Length", "8.0"
		ElseIf attName = "Shape_Area" Then
			SetTagValByName att.TaggedValues, "Length", "8.0"
		Else
			SetTagValByName att.TaggedValues, "Length", "0.0"
		End If

		SetTagValByName att.TaggedValues, "Required", "true"

		If attName = "Shape" Then
			Dim geomDef
			geomDef = "AvgNumPoints=0;" & VbCrLf & "GridSize0=0;"
			SetTagValByNameEx att.TaggedValues, "GeometryDef", "<memo>", geomDef
			SetTagValByName el.TaggedValues, "ShapeFieldName", att.AttributeGUID
		ElseIf attName = "OBJECTID" Then
			SetTagValByName el.TaggedValues, "OIDFieldName", att.AttributeGUID
		ElseIf attName = "Shape_Length" Then
			If elStereo = "Polygon" Or elStereo = "Polyline" Then
				SetTagValByName el.TaggedValues, "LengthFieldName", att.AttributeGUID
			End If
		ElseIf attName = "Shape_Area" Then
			If elStereo = "Polygon" Then
				SetTagValByName el.TaggedValues, "AreaFieldName", att.AttributeGUID
			End If
		End If
	End If

End Sub

Sub AddAttributeIndex(el)

	Dim att As EA.Attribute
	Set att = GetAttByName(el.Attributes, "OBJECTID_IDX")
	If Not att Is Nothing Then
		If att.Stereotype <> "AttributeIndex" Then
			att.StereotypeEx = "AttributeIndex"
		Else
			Session.Output VbTab & VbTab & "Error: Attribute named 'OBJECTID_IDX' in element named '"&el.Name&"' already has AttributeIndex stereotype. Some tagged values will not be added to this attribute."
		End If
	Else
		Set att = el.Attributes.AddNew("OBJECTID_IDX", "")
		If Not att Is Nothing Then
			el.Attributes.Refresh
			att.StereotypeEx = "ArcGIS::AttributeIndex"
		Else
			Session.Output VbTab & VbTab & "Error: Failed to create AttributeIndex named 'OBJECTID_IDX' for element named '"&el.Name&"'."
		End If
	End If

	If Not att Is Nothing Then
		' The Update call saves the stereotype and adds the tags to the repository, so refresh the tags collection as well
		att.Update
		att.TaggedValues.Refresh
	End If

End Sub

Sub AddSpatialIndex(el)

	Dim att As EA.Attribute
	Set att = GetAttByName(el.Attributes, "Shape_IDX")
	If Not att Is Nothing Then
		If att.Stereotype <> "SpatialIndex" Then
			att.StereotypeEx = "SpatialIndex"
		Else
			Session.Output VbTab & VbTab & "Error: Attribute named 'Shape_IDX' in element named '"&el.Name&"' already has SpatialIndex stereotype. Some tagged values will not be added to this attribute."
		End If
	Else
		Set att = el.Attributes.AddNew("Shape_IDX", "")
		If Not att Is Nothing Then
			el.Attributes.Refresh
			att.StereotypeEx = "ArcGIS::SpatialIndex"
		Else
			Session.Output VbTab & VbTab & "Error: Failed to create SpatialIndex named 'Shape_IDX' for element named '"&el.Name&"'."
		End If
	End If

	If Not att Is Nothing Then
		' The Update call saves the stereotype and adds the tags to the repository, so refresh the tags collection as well
		att.Update
		att.TaggedValues.Refresh
	End If

End Sub

Function GetAttByName(atts, name)

	If atts Is Nothing Or Len(name) = 0 Then
		Session.Output "Internal Error: GetAttByName cannot accept Null parameters."
		Set GetAttByName = Nothing
		Exit Function
	End If

	Dim ret As EA.Attribute
	Set ret = Nothing

	Dim idx
	Dim att
	For idx = 0 To atts.Count - 1
		Set att = atts.GetAt(idx)
		If Not att Is Nothing Then
			If att.Name = name Then
				Set ret = att
				Exit For
			End If
		End If
	Next

	Set GetAttByName = ret

End Function

' Optimized version of GetElByName. Use a global dictionary for lookup rather than looping over an array
Function GetElByName(name)

	If Len(name) = 0 Then
		Session.Output "Internal Error: GetElByName cannot accept Null parameters."
		Set GetElByName = Nothing
		Exit Function
	End If

	If nameClasses.Exists(name) = True Then
		Set GetElByName = nameClasses(name)
	Else
		Set GetElByName = Nothing
	End If

End Function

' Optimized version of GetElByID. Use a global dictionary for lookup rather than looping over an array
Function GetElByID(id)

	If idClasses.Exists(id) = True Then
		Set GetElByID = idClasses(id)
	Else
		Set GetElByID = Nothing
	End If

End Function

' Get the EA.Package object with PackageID matching id
Function GetPkgByID(id)

	If idPkgs.Exists(id) = True Then
		Set GetPkgByID = idPkgs(id)
	Else
		Set GetPkgByID = Nothing
	End If

End Function


' Adds the Element ID of Geometric Network class to the global list of Geometric Nework Ids
Sub AddGeometricNetworkID(id)

	If gnIdTypes.Exists(id) = False Then
		gnIdTypes(id) = ""
	End If

End Sub

' Gets the Geometric Network Type value for the Geometric Network class with ElementID of id
Function GetGeometricNetworkTypeByID(id)

	If gnIdTypes.Exists(id) = True Then
		Set GetGeometricNetworkByID = gnIdTypes(id)
	Else
		Set GetGeometricNetworkByID = ""
	End If

End Function

' Sets the Geometric Network Type value for the Geometric Network class with ElementID of id
Sub SetGeometricNetworkType(id, nType)

	If gnIdTypes.Exists(id) = True Then
		gnIdTypes(id) = nType
	End If

End Sub

' Returns a zero-based array of package ids that represent descendants of the package with package id: rootID
' Recurses over sub-packages and adds their descendants to aryIds
Sub GetDescendantPkgs(rootID, ByRef aryIds)

	Dim sql, aryChildIds
	sql = "SELECT t_package.Package_ID FROM t_package WHERE t_package.Parent_ID=" & rootID
	aryChildIds = BuildArrayFromSQL(sql,"Package_ID")
	
	If UBound(aryChildIds) < 0 Then
		Exit Sub
	End If
	
	Dim id, pos
	pos = UBound(aryIds) + 1
	For Each id In aryChildIds
		Redim Preserve aryIds(pos)
		aryIds(pos) = id
		pos = pos + 1
	Next
	
	For Each id In aryChildIds
		GetDescendantPkgs id, aryIds
	Next
	
End Sub

Function GetDefaultSubtypeCode(el)

	If el Is Nothing Then
		Session.Output "Internal Error: GetDefaultSubtypeCode routine cannot accept Null parameters"
		GetDefaultSubtypeCode = -1
		Exit Function
	End If

	Dim idx
	Dim con As EA.Connector
	Dim minVal
	minVal = -1
	For idx = 0 To el.Connectors.Count - 1
		Set con = el.Connectors.GetAt(idx)
		If el.ElementID = con.SupplierID And con.Stereotype = "Subtype" Then
			Dim subtype As EA.Element
			Set subtype = GetElByID(con.ClientID)
			If subtype Is Nothing Then
				Session.Output "Error: Could not locate a subtype of element: " & el.Name & " where connector GUID is: " & con.ConnectorGUID
			Else
				Dim subtypeCode
				subtypeCode = GetSubtypeCode(subtype)
				If minVal = -1 Or subtypeCode < minVal Then
					minVal = subtypeCode
				End If			
			End If
		End If
	Next

	GetDefaultSubtypeCode = CStr(minVal)

End Function

' Searches for the SubtypeCode field/attribute.
' If a numeric code is set in the attribute's initial value, returns the value as an integer
' Returns the integer -1, otherwise.
Function GetSubtypeCode(subtype)

	Dim ret
	ret = -1

	If subtype Is Nothing Then
		Session.Output "Internal Error: GetSubtypeCode routine cannot accept Null parameters"
		GetSubtypeCode = ret
		Exit Function
	End If

	Dim idx
	Dim att As EA.Attribute
	For idx = 0 To subtype.Attributes.Count - 1
		Set att = subtype.Attributes.GetAt(idx)
		If LCase(att.Stereotype) = "subtypefield" Then
			If Len(att.Default) > 0 And IsNumeric(att.Default) = True Then
				ret = CLng(att.Default)
			End If
		End If
	Next

	GetSubtypeCode = ret

End Function

Sub ProcessField(att)

	att.StereotypeEx = "Field"
	ConvertAllowNullsTag att
	ConvertAliasTag att
	att.Update
	att.TaggedValues.Refresh
	MigrateUnqualifiedTags att.TaggedValues, "IsNullable,Length,Precision,Scale", "attribute", att.Name

End Sub

Sub ProcessSubtypeField(att)

	' First, reset the stereotype so we can force EA to automatically add the required tags later
	att.StereotypeEx = ""
	att.Update
	att.StereotypeEx = "SubtypeField"
	ConvertAllowNullsTag att
	ConvertAliasTag att
	att.Update
	att.TaggedValues.Refresh
	MigrateUnqualifiedTags att.TaggedValues, "IsNullable,Length,Precision,Scale", "attribute", att.Name

End Sub

Sub ConvertBooleanTagCase(tags)

	If Not tags Is Nothing Then
		Dim i
		Dim tag As EA.TaggedValue
		Dim val, lowerVal
		For i = 0 To tags.Count - 1
			Set tag = tags.GetAt(i)
			val = tag.Value
			lowerVal = LCase(val)
			If lowerVal = "true" Or lowerVal = "false" Then
				' Only do the update if the value isn't already lower case
				If val <> lowerVal Then
					tag.Value = lowerVal
					tag.Update
				End If
			End If
		Next
	End If

End Sub

Sub ConvertAllowNullsTag(att)

	Dim tag As EA.TaggedValue
	Set tag = GetTagByNameNoCase(att.TaggedValues, "AllowNulls")
	If Not tag Is Nothing Then
		tag.Name = "IsNullable"
		tag.Value = LCase(tag.Value)
		tag.Update
	End If

End Sub

Sub ConvertAliasTag(att)

	Dim val
	val = GetTagValByNameNoCase(att.TaggedValues, "Alias")
	If Len(val) > 0 Then
		'The Style property actually contains the alias for an Attribute.
		att.Style = val
		RemoveTagByNameNoCase att.TaggedValues, "Alias"
	End If

End Sub

' Converts unqualified tagged values in collection tags to the corresponding qualified tag.
' tags is an EA.Collection of tagged values.
' tagNames specifies which tags should be migrated. It is a comma separated list of names.
' The value of each unqualified tag is reassigned to its qualified equivalent and then deleted.
' This function does not create new qualified tags if they do not exist.
Sub MigrateUnqualifiedTags(tags, tagNames, objType, objName)

	Dim names, count
	names = Split(tagNames, ",")
	count = UBound(names)

	' Use a 2D array to store each name with positions
	' ary(i,0) : the tag name
	' ary(i,1) : the position of the unqualified tag in the tags collection
	' ary(i,2) : the position of the qualified tag in the tags collection
	Dim ary()
	ReDim ary(count,2)
	Dim i
	For i = 0 To count
		ary(i,0) = names(i)
		ary(i,1) = -1
		ary(i,2) = -1
	Next

	Dim tag As EA.TaggedValue
	For i = 0 To tags.Count - 1
		Set tag = tags.GetAt(i)
		Dim tagName: tagName = tag.Name
		' Match this tag to one of the supplied names
		Dim j
		For j = 0 To UBound(ary)
			If tagName = ary(j,0) Then
				If Left(tag.FQName,8) <> "ArcGIS::" Then
					' Mark the position of the unqualified tag
					ary(j,1) = i
				Else
					' Mark the position of the qualified tag
					ary(j,2) = i
				End If
				Exit For
			End If
		Next
	Next

	Dim bRefresh: bRefresh = False
	For i = 0 To count
		If ary(i,1) > -1 And ary(i,2) > -1 Then
			' Get unqualified tag value
			Dim val: val = tags.GetAt(ary(i,1)).Value
			Dim lower: lower = LCase(val)
			' Convert a boolean value if necessary
			If lower = "true" Or lower = "false" Then
				val = lower
			End If
			' Get the qualified tag
			Set tag = tags.GetAt(ary(i,2))
			tag.Value = val
			tag.Update
			tags.DeleteAt ary(i,1), false
			bRefresh = True
		ElseIf ary(i,1) > -1 Then
			Session.Output "Error: Unable to migrate "&ary(i,0)&" value for "&objType&": " &objName
		End If
	Next

	If bRefresh = True Then
		tags.Refresh
	End If

End Sub


' This routine cleans the Esri core interfaces, classes and diagram associated with the ArcInfo model template.
' The clean-up operations are hardwired to reflect a reference model created in Enterprise Architect, based on Esri's ArcInfo template.
' The script assumes that the ArcInfo model was imported from Visio into Enterprise Architect using version 9.3.932, or later, with the Visio Importer add-in for EA.
' Most operations just compensate for discrepancies created by the import process.
' The following operations are performed:
'	1. Convert all classes under "Esri Interfaces" package to UML interfaces
'	2. Move the "Esri Classes Diagram" to the "ESRI Classes" package
'	3. Change all «refines»/Association relationship to UML's "«refine»"/Dependency relationship
'	4. Remove the names from all connectors in the ArcInfo model (they are garbage names auto generated by the XMI export/import process)
'	5. On "Esri Classes Diagram":
'		- Hide all Operations and Attributes
'		- Suppress display of Parent information for all interfaces
'		- Remove any extraneous/duplicate diagram links. They have been rerouted in the reference model for Enterprise Architect.
'		  (The duplicate links seem to have resulted from elements being drawn on a diagram multiple times in Visio)
'	6. Hide connectors owned by any interface on the "Esri Classes" diagram. This is really just the Generatization connectors.
'	7. Update element sizes and positions on the "Esri Classes" diagram
'	8. Change connector styles:
'		- Change Generalization connector style to "Tree Style - Vertical. Style: TREE=V
'		- Change <<refines>> connectors to "Orthogonal - Square". Style: TREE=OS;
'	9. On "ESRI Interfaces Diagram":
'		- Update element sizes and positions
'		- Update connector geometry
'		- Strip double spacing from Note elements
'   10. On "ESRI Generic Junction Diagram":
'		- Update element sizes and positions
'		- Update connector geometry
'		- Change the <<Subtype>> Association to a Generalization
'		- Strip double spacing from Note elements
Sub CleanEsriArcInfoElements

	' 1. Convert all classes under "Esri Interfaces" package to UML interfaces
	Dim interfacesPkg As EA.Package
	Set interfacesPkg = FindPkgByName("ESRI Interfaces")
	If Not interfacesPkg Is Nothing Then
		UpdateEsriInterfaces interfacesPkg
		RemoveTagByName interfacesPkg.Element.TaggedValues, "visio_uid"
	Else
		Session.Output "Error: Could not find the 'ESRI Interfaces' Package."
	End If

	Dim dgm As EA.Diagram
	Set dgm = FindDgmByName("ESRI Classes Diagram")
	Dim classPkg As EA.Package
	Set classPkg = FindPkgByName("ESRI Classes")
	If Not classPkg Is Nothing And Not dgm Is Nothing Then
		RemoveTagByName classPkg.Element.TaggedValues, "visio_uid"

		' 2. Move the "Esri Classes Diagram" to the "ESRI Classes" package
		MoveEsriClassesDgm dgm, classPkg

		' Get rid of the visio_uid tags
		Dim idx, el
		For idx = 0 To classPkg.Elements.Count - 1
			Set el = classPkg.Elements.GetAt(idx)
			RemoveTagByName el.TaggedValues, "visio_uid"
			RemoveTagByName el.TaggedValues, "CLSID"
		Next

		' 3. Change all «refines»/Association relationship to UML's "«refine»" Dependency relationship
		' 4. Remove names from all other relationships in the ArcInfo Model
		UpdateClassRelationships classPkg.Elements, True
		Dim networkClassesPkg As EA.Package
		set networkClassesPkg = FindPkgByName("ESRI Network")
		If Not networkClassesPkg Is Nothing Then
			RemoveTagByName networkClassesPkg.Element.TaggedValues, "visio_uid"
			For idx = 0 To networkClassesPkg.Elements.Count - 1
				Set el = networkClassesPkg.Elements.GetAt(idx)
				UpdateSubtypeRelationships el, True
				RemoveTagByName el.TaggedValues, "visio_uid"
			Next
			UpdateClassRelationships networkClassesPkg.Elements, True
		Else
			Session.Output "Error: Could not find the 'ESRI Network' Package."
		End If

		' 5. Hide all Operations and Attributes for all interfaces on the "Esri Classes" diagram
		' 6. Hide Generalization connectors for all interfaces
		' 7. Update element sizes and positions
		' 8. Set connectors styles and geometry
		CleanClassesDiagram(dgm)
	ElseIf classPkg Is Nothing Then
		Session.Output "Error: Could not find the 'ESRI Classes' Package."
	Else
		Session.Output "Error: Could not find 'ESRI Classes Diagram'."
	End If

	' 9. Clean "ESRI Interfaces Diagram"
	Dim intDgm As EA.Diagram
	Set intDgm = FindDgmByName("ESRI Interfaces Diagram")
	If Not intDgm Is Nothing Then
		CleanInterfacesDiagram(intDgm)
	Else
		Session.Output "Error: Could not find 'ESRI Interfaces Diagram'."
	End If

	' 10. Clean "ESRI Generic Junction Diagram":
	Dim netDgm As EA.Diagram
	Set netDgm = FindDgmByName("ESRI Generic Junction Diagram")
	If Not netDgm Is Nothing Then
		CleanNetworkDiagram(netDgm)
	Else
		Session.Output "Error: Could not find 'ESRI Generic Junction Diagram'."
	End If

End Sub

' Returns the first package found with name matching PkgName
' If no match is found, returns Nothing
Function FindPkgByName(PkgName)

	' Note: This will work on EAP repositories, but maybe not other DBMS repositories like SQL Server etc.
	Dim pkg As EA.Package
	Set pkg = Nothing	
	Dim sql, ret, guid

	' No checks on PkgName. No safe SQL conversions. It had better be OK...
	sql = "SELECT ea_guid FROM t_object WHERE Object_Type = 'Package' AND Name ='" & PkgName & "'"
	ret = Repository.SQLQuery(sql)

	' Assume we only have 1 package with Name=PkgName. Just take the first result anyway.
	guid = ExtractFieldValFromXML(ret, "ea_guid")
	If Len(guid) > 0 Then
		Set pkg = GetPackageByGuid(guid)
	End If
	
	Set FindPkgByName = pkg
End Function

' Returns all packages found with a stereotype that matches stereo
' Results are returned via a zero-based array of EA.Package elements.
' pkgIDS can be used as a comma separated string to specify the range of allowed package IDs
Function GetPkgsByStereotype(stereo, pkgIDs)

	' Note: This will work on EAP repositories, but maybe not other DBMS repositories like SQL Server etc.	
	' No checks on stereo or pkgIDs. No safe SQL conversions. It had better be OK...
	Dim sql, ret, guids
	sql = "SELECT ea_guid FROM t_object WHERE Object_Type='Package' AND Stereotype ='" & stereo & "'"
	If Len(pkgIDs) > 0 Then
		Dim idstr
		idstr = ""

		Dim idary
		idary = Split(pkgIDs, ",")

		Dim id
		For Each id In idary
			idstr = idstr & "'" & id & "',"
		Next
		If Len(idStr) > 1 Then 
			idStr = Left(idStr, Len(idStr) - 1)
			sql = sql & " AND t_object.PDATA1 IN (" & idStr & ")"
		End If
	End If
	guids = BuildArrayFromSQL(sql, "ea_guid")

    Dim pkgs(), count
	count = 0
	ReDim pkgs(-1)

	Dim guid
	For Each guid in guids
		If Len(guid) > 0 Then
			Dim pkg As EA.Package
			Set pkg = GetPackageByGuid(guid)
			If Not pkg Is Nothing Then
				Redim Preserve pkgs(count)
				Set pkgs(count) = pkg
				count = count + 1
			End If
		End If
	Next

	GetPkgsByStereotype = pkgs

End Function

' Returns the first diagram found with name matching DgmName
Function FindDgmByName(DgmName)

	' As with FindPkgByName, searches t_diagram table via direct SQL command.
	' Unlikely to work on all DBMS repository types.
	Dim dgm As EA.Diagram
	Set dgm = Nothing
	Dim sql, ret, guid
	' No checks on PkgName. No safe SQL conversions. It had better be OK...
	sql = "SELECT ea_guid FROM t_diagram WHERE Name ='" & DgmName & "'"
	ret = Repository.SQLQuery(sql)

	' Assume we only have 1 diagram with Name=DgmName. Just take the first result anyway.
	guid = ExtractFieldValFromXML(ret, "ea_guid")
	If Len(guid) > 0 Then
		Set dgm = GetDiagramByGuid(guid)
	End If
	
	Set FindDgmByName = dgm

End Function

' Iterates through elements in InterfacePkg.
' Calls ConvertClassToInterface to change the element type to Interface.
' Calls CleanInterfaceConnectors to remove the garbage name on connectors owned by the interfaces.
Sub UpdateEsriInterfaces(InterfacePkg)

	If Not InterfacePkg Is Nothing Then
		Dim els As EA.Collection
		Set els = InterfacePkg.Elements
		Dim i
		Dim el As EA.Element
		For i = 0 To els.Count - 1
			Set el = els.GetAt( i )
			ConvertClassToInterface(el)
			RemoveTagByName el.TaggedValues, "visio_uid"
		Next

		' Need to iterate over the collection separately for some reason
		' Otherwise the connector updates don't work. Maybe related to changing the element type first.
		For i = 0 To els.Count - 1
			Set el = els.GetAt( i )
			CleanInterfaceConnectors(el)
		Next
	End If

End Sub

Sub ConvertClassToInterface(Elem)

	If Not Elem Is Nothing Then
		If Elem.Type = "Class" Then
			Session.Output "Processing element: " + Elem.Name
			Elem.StereotypeEx = "interface"
			Elem.Type = "Interface"
			Elem.Abstract = "1"
			Elem.Update
		End if
	End If

End Sub

' Wipes out the name of any generalization connector for which Interface is the source element
' This removes garbage XMI-export names for the standard ArcInfo interface elements
' Leaves all other connector names intact in case they are user-defined.
Sub CleanInterfaceConnectors(Interface)

	If Not Interface Is Nothing Then
		Dim cons As EA.Collection
		Set cons = 	Interface.Connectors
		Session.Output "Processing element named: " + Interface.Name
		If Not cons Is Nothing Then
			Dim i
			cons.Refresh
			For i = 0 To cons.Count - 1
				Dim con As EA.Connector;
				Set con = Cons.GetAt( i )
				If Not con Is Nothing Then
					If Len(con.Name) > 0 Then
						Session.Output "Processing connector named: " + con.Name + ", with GUID: " + con.ConnectorGUID + ", of Type: " + con.Type + ", Source Name: "
					Else
						Session.Output "Processing unnamed connector, with GUID: " + con.ConnectorGUID + ", of Type: " + con.Type + ", Source Name: "
					End If
					If con.Type = "Generalization" And con.ClientID = Interface.ElementID And Len(con.Name) > 0 Then
						' Get rid of the garbage name inserted by the XMI export
						Session.Output VbTab & "Wiping out connector name: " + con.Name
						con.Name = ""
						con.Update
						ClearTopMidLabel(con)
					End If
					RemoveTagByName con.TaggedValues, "visio_uid"
				End If
			Next
		End If
	End If

End Sub

Sub MoveEsriClassesDgm(Dgm, ClassesPkg)

	If Not Dgm Is Nothing Then
		If Not ClassesPkg is Nothing Then
			If Not ClassesPkg.PackageID = Dgm.PackageID Then
				Session.Output "Moving 'Esri Classes' diagram' to the 'Esri Classes' package..."
				Dim oldID
				oldID = Dgm.PackageID
				Dgm.PackageID = ClassesPkg.PackageID
				Dgm.Update
			End If
		End If
	End If

End Sub

' Changes Associations named <<refines>> to a proper UML refine connector
' Changes Associations with stereotype of <<subtype>> to a generalization connector
' Skips over subtype relationships
' Skips over Geometric Network relationships - the related classes get moved separately at the end with the redundant connectors deleted thereafter.
' Removes the names on all other relationships owned by ArcInfo class elements
' Removes autogenerated role names of the form: End<number>
' Removes visio_uids tagged values
' parameter "els" must be of type EA.Collection, representing the Class elements to processed
Sub UpdateClassRelationships(els, bIsEsriClass)
	If Not els is Nothing Then
		Dim idx
		Dim el As EA.Element
		For idx = 0 To els.Count - 1
			Set el = els.GetAt(idx)

			' Geometric Networks are converted separately, the connectors are deleted after the related elements are moved, so skip them for now...
			If el.Stereotype <> "GeometricNetwork" Then

				Dim cons As EA.Collection
				Set cons = el.Connectors
				Dim idxCon
				Dim con As EA.Connector
				For idxCon = 0 To cons.Count - 1
					Set con = cons.GetAt(idxCon)

					' Only update connectors owned by this element
					If con.ClientID = el.ElementID Then
						Dim endEl As EA.Element
						Dim relClass As EA.Element
						Set endEl = Nothing
						Set relClass = Nothing

						Dim conName
						conName = con.Name

						Dim conSupplierID
						conSupplierID = con.SupplierID

						Dim conStereoOrig, conStereo
						conStereoOrig = con.Stereotype
						conStereo = LCase(conStereoOrig)

						Dim pos1, pos2
						pos1 = InStr(1, conName, "*")
						pos2 = InStr(1, conName, "..")
						' Check if we have a bogus connector...
						If pos1 > 0 Or pos2 > 0 Or IsNumeric(conName) Then
							Set endEl = GetElementByID(conSupplierID)
							Session.Output "Deleting spurious connector named: " & conName & ". Client element is: " & el.Name & ". Supplier element is: " & endEl.Name
							cons.DeleteAt idxCon, false

						' Subtypes are already processed by UpdateSubtypeRelationships...
						' Don't bother processing any links to Geometric Networks classes either, as they get converted at the end...
						ElseIf conStereo <> "subtype" And gnIdTypes.Exists(conSupplierID) = False Then
							RemoveTagByName con.TaggedValues, "visio_uid"

							Dim conTypeOrig, conType 
							conTypeOrig = con.Type
							conType = LCase(conTypeOrig)

							Dim bSkip
							bSkip = False

							Dim logtxt
							If Len(conName) > 0 Then
								logtxt = "Updating connector named: " & conName & ", of type: " & conTypeOrig
							Else
								logtxt = "Updating unnamed connector, with GUID: " & con.ConnectorGUID & ", of type: " & conTypeOrig
							End If

							If Len(conStereo) > 0 Then
								logtxt = logtxt + ", with Stereotype: " + conStereoOrig
							End If
							Session.Output logtxt

							If conType = "association" And conName = "«refines»" Then
								Session.Output VbTab & "Converting to a UML <<refine>> relationship"
								con.Type = "Dependency"
								con.StereotypeEx = "refine"
							ElseIf conType = "association" And conStereo = "connrule" Then
								Session.Output VbTab & "Found connectivity rule relationship"
							ElseIf conType = "association" Then
								Set endEl = GetElementByID(conSupplierID)
								If endEl.Stereotype = "Subtype" And el.Stereotype = "Subtype" Then
									con.StereotypeEx = "RelationshipRule"
									SetTagValByNameEx con.TaggedValues, "RuleID", "", ""
								ElseIf bIsEsriClass = False Then
									' Assume a RelationshipClass, but don't process it more than once.
									If conStereo = "relationshipclass" And Len(GetTagValByName(con.TaggedValues, "visio_uid")) = 0 And Len(GetTagValByName(con.TaggedValues, "OriginClass")) = 0 Then
										bSkip = True
										Session.Output VbTab & "Connector has already been converted to a RelationshipClass."
									Else
										con.StereotypeEx = "RelationshipClass"
										Session.Output VbTab & "Assuming a RelationshipClass... Adding tagged values"
										' Note: This call can reverse con.ClientID and con.SupplierID, hence the check above to ensure we don't reprocess it in a subsequent iteration
										Set relClass = AddRelationshipClassTags(con, el, endEl)
									End If
								End If
							End If

							If bSkip = False Then

								If IsRoleAutoNamed(con.ClientEnd.Role) = True Then
									con.ClientEnd.Role = ""
									con.ClientEnd.Update
								End If

								If IsRoleAutoNamed(con.SupplierEnd.Role) = True Then
									con.SupplierEnd.Role = ""
									con.SupplierEnd.Update
								End If

								Dim oldName
								If IsConAutoNamed(conName) Or conName = "«refines»" Then
									Session.Output VbTab & "Wiping out auto-generated connector name: '" & conName & "'. Client element is: " & el.Name & ". Connector ID is: " & con.ConnectorID
									oldName = conName
									conName = ""
									con.Name = ""
								End If

								con.Update
								If Len(oldName) > 0 Then
									ClearTopMidLabel(con)
								End If

								If Not relClass Is Nothing Then
									' Make an AssociationClass out of relClass if it is not already...
									' Note: Must do this after the call to con.Update, since EA.Element.CreateAssociationClass changes con behind the scenes.
									' 		con would have to be reloaded via EA.Repository.GetConnectorByID, before a subsequent call to Update, else it damages the newly created AssociationClass link.
									If relClass.IsAssociationClass = False Then
										Session.Output VbTab & "Found a matching Association and Class for RelationshipClass. Converting Class: " & relClass.Name & " to a UML AssociationClass."
										Dim ret
										ret = relClass.CreateAssociationClass(con.ConnectorID)
										If ret = False Then
											Session.Output "Error: Failed to convert Class: " & relClass.Name & " to an AssociationClass."
										End If
									End If
								End if
							End If
						ElseIf conStereo = "subtype" Then
							' Get rid of the visio_uid on <<Subtype>> connectors as well
							RemoveTagByName con.TaggedValues, "visio_uid"
						End If
					End If
				Next
			End If
		Next
	End If
End Sub

Sub UpdateSubtypeRelationships(el, bIsEsriClass)
	Dim cons As EA.Collection
	Set cons = el.Connectors
	Dim idxCon
	Dim con As EA.Connector
	For idxCon = 0 To cons.Count - 1
		Set con = cons.GetAt(idxCon)
		' Only update connectors owned by this element
		If con.ClientID = el.ElementID Then
			' The ArcMarine reference model uses the name "SubType", instead of the stereotype, so look for either
			If con.Type = "Association" And LCase(con.Stereotype) = "subtype" Or LCase(con.Name) = "subtype" Then
				Dim logtxt, oldName
				If Len(con.Name) > 0 Then
					logtxt = "Converting connector named: " & con.Name & ", of type: " & con.Type & ", with Stereotype: " & con.Stereotype & " to a UML Generalization relationship"
				Else
					logtxt = "Converting unnamed connector, with GUID: " & con.ConnectorGUID & ", of type: " & con.Type & ", with Stereotype: " & con.Stereotype & " to a UML Generalization relationship"
				End If
				Session.Output logtxt
				If LCase(con.Name) = "subtype" Then
					oldName = con.Name
					con.Name = ""
					con.Stereotype = "Subtype" ' SterotypeEx is set later, but without setting stereotype here, the value is not set properly
				ElseIf IsConAutoNamed(con.Name) Then
					oldName = con.Name
					Session.Output VbTab & "Wiping out auto-generated connector name: '" & con.Name & "'. Client element is: " & el.Name & ". Connector ID is: " & con.ConnectorID
					con.Name = ""
				End If
				con.Type = "Generalization"
				con.StereotypeEx = "Subtype" ' Camel Case the stereotype
				con.RouteStyle = 2
				con.ClientEnd.Role = ""
				con.ClientEnd.Cardinality = ""
				con.ClientEnd.Update
				con.SupplierEnd.Role = ""
				con.SupplierEnd.Cardinality = ""
				con.SupplierEnd.Update

				' We don't know yet which element is parent or child (feature class or subtype)
				If bIsEsriClass = True And el.Name = "GenericJunction" Then
					' We know which way the Esri subtype relationship is supposed to be, so fix it
					ReverseConnectorDirection con
				ElseIf bIsEsriClass = False Then
					Dim bFoundSubtype
					Dim fc As EA.Element
					Dim subtype As EA.Element
					bFoundSubtype = GetSubtypeRelation(con, el, fc, subtype)

					If bFoundSubtype = True Then
						' We may have to reverse the connector direction...
						If fc.ElementId = el.ElementID Then
							ReverseConnectorDirection con
						End If

						' The parent may not yet be stereotyped in the case of an ObjectClass--Subtype relationship
						If Len(fc.Stereotype) = 0 Then
							Session.Output VbTab & "Setting stereotype of Element: " & fc.Name & " to <<ObjectClass>>"
							fc.StereotypeEx = "ObjectClass"
							fc.Update
						End If

						' Find the subtypefield in the feature/object class
						Dim subtypeField
						Dim att As EA.Attribute
						Set att = GetSubtypeField(fc)
						If Not att Is Nothing Then
							subtypeField = att.Name
							' Correct the stereotype case, if necessary
							If att.Stereotype <> "SubtypeField" Then
								Session.Output VbTab & "Setting stereotype of SubtypeField to correct case."
								att.StereotypeEx = "SubtypeField"
								att.Update
								att.TaggedValues.Refresh
								MigrateUnqualifiedTags att.TaggedValues, "IsNullable,Length,Precision,Scale", "attribute", subtypeField
							End If
						End If

						' A subtype can have multiple feature classes, so don't try to convert it more than once
						If subtype.Stereotype <> "Subtype" Then
							ConvertElementToSubtype subtype, subtypeField							
						End If
					End If
				End If
				con.Update
				If Len(oldName) > 0 Then
					ClearTopMidLabel(con)
				End If
			End If
		End If
	Next
End Sub

' Because the visio association connector for subtypes has no direction, we cannot easily determine subtype and feature/object class from the connector itself
' This function attempts to determine the elements which correspond to the feature/object class and subtype
' It accounts for various common modeling issues in the Visio model, such as both elements specifying geometry type.
' con is the EA.Connector object in question
' startEl is the EA.Element at the client end of con.
' Returns the feature/object class (parent element) via the parameter: featureClass. Null if not found.
' Returns the subtype (child element) via the parameter: subtype. Null if not found.
' Returns True, if start and end elements are determined
' Returns False otherwise.
Function GetSubtypeRelation(con, startEl, featureClass, subtype)
	Dim ret
	ret = False
	Set featureClass = Nothing
	Set subtype = Nothing

	If con Is Nothing Or startEl Is Nothing Then
		Session.Output VbTab & "Internal Error: GetSubtypeRelation cannot accept Nullparameters for con, startEl."
		Exit Function
	End If

	If startEl.ElementID = con.ClientID Then
		Set featureClass = GetElByID(con.SupplierID)
		If Not featureClass Is Nothing Then
			Session.Output VbTab & "Attempting to determine the Subtype element in relationship: " & startEl.Name & "->"  & featureClass.Name
		
			Dim bIsEndParent, bIsStartParent
			bIsEndParent = IsFeatureClassStereotype(featureClass.Stereotype) Or featureClass.Stereotype = "ObjectClass"
			bIsStartParent = IsFeatureClassStereotype(startEl.Stereotype) Or startEl.Stereotype = "ObjectClass"

			' Special case: If an element participates in a RelationshipClass connector, it can't be the subtype.
			' It might be an unstereotyped ObjectClass (table) ie. the parent and the subtypes may erroneously specify geometry type.
			Dim bIsStartElInRelClass, bIsFCInRelClass
			bIsStartElInRelClass = IsInRelationshipClass(startEl)
			bIsFCInRelClass = IsInRelationshipClass(featureClass)

			If bIsFCInRelClass = True And bIsStartElInRelClass = True Then
				Session.Output VbTab & "Error: Both elements in Subtype relationship: " & startEl.Name & " --> " & featureClass.Name & ", participate in a RelationshipClass. Attempting to deduce the subtype based on other criteria..."
			End If

			If bIsFCInRelClass = True And bIsStartElInRelClass = False Then
				Set subtype = startEl
				ret = True
			ElseIf bIsFCInRelClass = False And bIsStartElInRelClass = True Then
				Set subtype = featureClass
				Set featureClass = startEl
				ret = True
			ElseIf bIsEndParent = True Then
				' If we get this far, neither element is a participant in a RelationshipClass or both are (invalidly).
			
				' In theory, a subtype links to a feature class, so we should be able to guarantee start and end elements based on this...
				'...but some visio models define a geometry type for elements at both ends
				If bIsStartParent = True Then
					Session.Output VbTab & "Warning: Both elements in Subtype relationship were tagged as Feature/Object Classes: " & startEl.Name & " --> " & featureClass.Name
					' As a last ditch attempt, see if the we already determined the parent and subtype elements or
					' if the <<subtype>> stereotype is applied in only one class. If so, treat that as the parent class
					DeduceSubtypeElement startEl, subtype, featureClass
					If subtype Is Nothing Then
						Set featureClass = Nothing
					Else
						ret = True
					End If
				Else
					Set subtype = startEl
					ret = True
				End If
			ElseIf bIsStartParent = True Then
				Set subtype = featureClass
				Set featureClass = startEl
				ret = True
			Else
				' The subtype relationship might be between an unstereotyped ObjectClass (Table) and unstereotyped Subtype...
				' In this scenario, we rely on the parent class having a stereotyped subtype field and not the subtype element.
				' Otherwise there isn't a good determinant to separate the parent element from the subtype
				DeduceSubtypeElement startEl, subtype, featureClass
				If subtype Is Nothing Then
					Set featureClass = Nothing
				Else
					ret = True
				End If
			End If
		Else
			Session.Output VbTab & "Error: Could not locate supplier element in subtype relationship"
		End If
	Else
		Session.Output VbTab & "Error: Could not locate client element in subtype relationship"
	End If

	GetSubtypeRelation = ret
End Function


' Determines which element, startEl or featureClass, is really the parent (Feature) class and which is the Subtype.
' First checks whether startEl or featureClass have any dependant classes explicitly labeled <<Subtype>>, in this workspace.
' If so, that is assumed to be the parent for all other subtype relationships, and the subtype and featureClass parameters are set accordingly
' Otherwise, searches through the attributes of startEl and featureClass to find a match on <<SubtypeField>>.
' If only one class has a match, that is assumed to be the parent and the subtype and featureClass parameters are set accordingly
' Otherwise, the subtype parameter is set to Nothing and the featureClass parameter remains unchanged.
Sub DeduceSubtypeElement(startEl, subtype, featureClass)

	Set subtype = Nothing

	'First Check: We might have processed the parent class already, in which case one class already has dependant classes stereotyped as <<subtype>>
	Dim bStartHasSubtypes, bFeatureHasSubtypes
	bStartHasSubtypes = HasSubtypeChildEls(startEl)
	bFeatureHasSubtypes = HasSubtypeChildEls(featureClass)
	If bStartHasSubtypes = False And bFeatureHasSubtypes = True Then
		Set subtype = startEl
		Session.Output VbTab & VbTab & "Assuming the subtype element is: " & startEl.Name & ", based on sibling subtype element(s)."
	ElseIf bStartHasSubtypes = True And bFeatureHasSubtypes = False Then
		Set subtype = featureClass
		Set featureClass = startEl
		Session.Output VbTab & VbTab & "Assuming the subtype element is: " & subtype.Name & ", based on sibling subtype element(s)."
	ElseIf bStartHasSubtypes = False And bFeatureHasSubtypes = False Then
		'Second Check: If only one class has an attribute with the stereotype <<SubtypeField>>, assume that is the parent
		Dim attStart As EA.Attribute
		Dim attEnd As EA.Attribute
		Set attStart = GetSubtypeField(startEl)
		Set attEnd = GetSubtypeField(featureClass)
		If attStart Is Nothing And Not attEnd Is Nothing Then
			Set subtype = startEl
			Session.Output VbTab & VbTab & "Assuming the subtype element is: " & startEl.Name & ", based on location of <<SubtypeField>> attribute."
		ElseIf Not attStart Is Nothing And attEnd Is Nothing Then
			Set subtype = featureClass
			Set featureClass = startEl
			Session.Output VbTab & VbTab & "Assuming the subtype element is: " & subtype.Name & ", based on location of <<SubtypeField>> attribute."
		Else
			Session.Output VbTab & VbTab & "Error: Could not determine the subtype element"
		End If
	Else
		Session.Output VbTab & VbTab & "Error: Could not determine the subtype element"
	End If

End Sub

' Returns True, if el has at least one related element within this workspace that is stereotyped <<Subtype>>
' Returns False, otherwise
Function HasSubtypeChildEls(el)

	Dim ret
	ret = False

	Dim idx
	Dim con As EA.Connector
	For idx = 0 To el.Connectors.Count - 1
		Set con = el.Connectors.GetAt(idx)
		If el.ElementID = con.SupplierID And con.Stereotype = "Subtype" Then
			Dim subtype As EA.Element
			Set subtype = GetElByID(con.ClientID)
			If subtype Is Nothing Then
				Session.Output "Error: Could not locate a subtype of element: " & el.Name & " where connector GUID is: " & con.ConnectorGUID
			Else
				If subtype.Stereotype = "Subtype" Then
					ret = True
					Exit For
				End If			
			End If
		End If
	Next

	HasSubtypeChildEls = ret

End Function

' Returns True, if el participates in at least one RelationshipClass connector (at either end)
' Returns False, otherwise
Function IsInRelationshipClass(el)

	Dim ret
	ret = False

	Dim idx
	Dim con As EA.Connector
	For idx = 0 To el.Connectors.Count - 1
		Set con = el.Connectors.GetAt(idx)
		' Aggregation = 2 = Composite. This is a good enough match for RelationshipClass, even without stereotype
		If con.Stereotype = "RelationshipClass" Or con.ClientEnd.Aggregation = "2" Or con.SupplierEnd.Aggregation = "2" Then
			ret = True
			Exit For
		End If
	Next

	IsInRelationshipClass = ret

End Function

' Returns the first attribute in el.Attributes with stereotype <<SubtypeField>>.
' Returns Nothing if none found
Function GetSubtypeField(el)
	Dim ret As EA.Attribute
	Set ret = Nothing

	Dim idx
	Dim att As EA.Attribute
	Set att = Nothing
	For idx = 0 To el.Attributes.Count - 1
		Set att = el.Attributes.GetAt(idx)
		If Not att Is Nothing Then
			If LCase(att.Stereotype) = "subtypefield" Then
				Set ret = att
				Exit For
			End If
		End If
	Next

	Set GetSubtypeField = ret
End Function

Sub ConvertElementToSubtype(el, subtypeFieldName)
	If el Is Nothing Then
		Session.Output "Internal Error: ConvertElementToSubtype routine cannot accept Null parameters"
		Exit Sub
	End If

	Session.Output VbTab & "Converting client element named: " & el.Name &  ", to a <<Subtype>> element"

	el.StereotypeEx = "Subtype"

	' Some models add HasZ and HasM tags to subtypes, which is invalid
	Dim HasZ As EA.TaggedValue
	Dim HasM As EA.TaggedValue
	Set HasZ = GetTagByName(el.TaggedValues, "HasZ")
	Set HasM = GetTagByName(el.TaggedValues, "HasM")
	If Not HasZ Is Nothing Or Not HasM Is Nothing Then
		Session.Output VbTab & VbTab & "Warning: Found HasM and/or HasZ Tagged Values on Subtype. Deleting these Tagged Values."
		RemoveTagByName el.TaggedValues, "HasZ"
		RemoveTagByName el.TaggedValues, "HasM"
	End If

	el.Update

	' EA 9.3.934 (and earlier) expects the subtype element to use the stereotype as well, so set it
	Dim bFoundSubtypeField
	bFoundSubtypeField = False
	Dim idx
	If Len(subtypeFieldName) > 0 Then
		Dim att As EA.Attribute
		For idx = 0 To el.Attributes.Count - 1
			Set att = el.Attributes.GetAt(idx)
			If Not att Is Nothing Then
				' Do a case insensitive match on name
				Dim attName
				attName = att.Name
				If LCase(attName) = LCase(subtypeFieldName) Then
					bFoundSubtypeField = True
					' Raise a warning for case differences between the subtype field name in the Feature Class and Subtype
					If attName <> subtypeFieldName Then
						Session.Output VbTab & VbTab & "Warning: Detected difference in case between the subtype field name in the subtype ("&attName&") and the feature class( "&subtypeFieldName&"). Forcing the subtype field name to match that in the feature class."
						att.Name = subtypeFieldName
					End If
					att.StereotypeEx = "SubtypeField"
					att.Update
					' No point migrating existing tags - they are all redundant for the subtype element.
					DeleteAllTags att.TaggedValues
					Exit For
				End If
			End If
		Next
	End If

	If bFoundSubtypeField = False Then
		Session.Output VbTab & VbTab & "Error: Could not find the subtype field for the subtype element: " & el.Name & ". Set the <<SubtypeField>> stereotype manually on the appropriate field before generating an ArcGIS schema."
	End If

End Sub

' Locates primary and foreign key fields and sets the appropriate connector tags for a RelationshipClass.
' Changes the connector direction if needed to force the start element to match the origin class.
' For m-n relationships, attempts to locate the corresponding association class, which is usually not linked in the Visio model. (Match is based on name).
' 	Returns a pointer to the related class, if found
'	Returns Nothing, otherwise
' con.Update must be called after invoking this routine to persist the changes.
Function AddRelationshipClassTags(con, startEl, endEl)

	Dim relClass As EA.Element
	Set relClass = Nothing

	Dim tag As EA.TaggedValue
	Set tag = GetTagByName(con.TaggedValues, "OriginClass")
	If tag Is Nothing Then
		Session.Output VbTab & "Error: OriginClass tag on RelationshipClass connector not found. Set the Primary and Foreign keys manually for this relationship before generating an ArcGIS schema."
	ElseIf Len(tag.Value) = 0 Then
		Session.Output VbTab & "Error: OriginClass tag on RelationshipClass connector specified an empty value. Set the Primary and Foreign keys manually for this relationship before generating an ArcGIS schema."
	Else
		Dim origEl As EA.Element
		Dim destEl As EA.Element
		Set origEl = Nothing
		Set destEl = Nothing
		If tag.Value = startEl.Name Then
			Set origEl = startEl
			Set destEl = endEl
		ElseIf tag.Value = endEl.Name Then
			Set origEl = endEl
			Set destEl = startEl
		Else
			Session.Output VbTab & "Error: OriginClass value for RelationshipClass does not match Start or End Element."
		End If

		If Not origEl Is Nothing Then
			' We found a matching start element - see if there is an AssociationClass to go with the connector.
			' We can't really rely on the IsAttributed flag being set - too errorprone.
			Dim conName
			conName = con.Name
			If Len(conName) > 0 Then
				Set relClass = GetElByName(conName)
				If Not relClass Is Nothing Then
					If relClass.Stereotype <> "RelationshipClass" Then
						Session.Output VbTab & "Error: Class Element for RelationshipClass does not have the stereotype <<RelationshipClass>>."
					End If
				End If
			End If
	
			Dim bIsMN
			bIsMN = con.ClientEnd.Cardinality = "*" And con.SupplierEnd.Cardinality = "*"
			If bIsMN = True Then
				If Len(conName) = 0 Then
					Session.Output VbTab & "Error: Found unnamed connector. Connector name must be specified for a many-to-many RelationshipClass."
				Else
					Session.Output VbTab & "Processing m-n relationship: " & conName
					If relClass Is Nothing Then
						Session.Output VbTab & "Error: Could not find a matching class Element for RelationshipClass."
					End If
				End If
			End If

			' Get the OriginPrimaryKey
			Dim att As EA.Attribute
			Dim val
			val = GetTagValByName(con.TaggedValues, "OriginPrimaryKey")
			If Len(val) = 0 Then
				Session.Output VbTab & "Error: No OriginPrimaryKey value was specified for RelationshipClass."
			Else
				ProcessRelClassField con, "OriginPrimaryKey", val, origEl.AttributesEx
			End If

			' Now the OriginForeignKey
			val = GetTagValByName(con.TaggedValues, "OriginForeignKey")
			If Len(val) = 0 Then
				Session.Output VbTab & "Error: No OriginForeignKey value was specified for RelationshipClass."
			Else
				If relClass Is Nothing Then
					ProcessRelClassField con, "OriginForeignKey", val, destEl.AttributesEx
				Else
					ProcessRelClassField con, "OriginForeignKey", val, relClass.AttributesEx
				End If
			End If

			If bIsMN = False Then
				SetTagValByNameEx con.TaggedValues, "DestinationPrimaryKey", "", ""
				SetTagValByNameEx con.TaggedValues, "DestinationForeignKey", "", ""
			Else
				val = GetTagValByName(con.TaggedValues, "DestinationPrimaryKey")
				If Len(val) = 0 Then
					Session.Output VbTab & "Error: No DestinationPrimaryKey value was specified for many-to-many RelationshipClass."
				Else
					ProcessRelClassField con, "DestinationPrimaryKey", val, destEl.AttributesEx
				End If

				val = GetTagValByName(con.TaggedValues, "DestinationForeignKey")
				If Len(val) = 0 Then
					Session.Output VbTab & "Error: No DestinationForeignKey value was specified for many-to-many RelationshipClass."
				Else
					If Not relClass Is Nothing Then
						ProcessRelClassField con, "DestinationForeignKey", val, relClass.AttributesEx
					End If
				End If
			End If
		Else
			SetTagValByNameEx con.TaggedValues, "OriginPrimaryKey", "", ""
			SetTagValByNameEx con.TaggedValues, "OriginForeignKey", "", ""			
			SetTagValByNameEx con.TaggedValues, "DestinationPrimaryKey", "", ""
			SetTagValByNameEx con.TaggedValues, "DestinationForeignKey", "", ""
		End If

		RemoveTagByName con.TaggedValues, "OriginClass"

		' EA expects the Connector's Source/Start Element to be the Origin
		If Not origEl Is Nothing Then
			If origEl.ElementID <> startEl.ElementID Then
				Session.Output VbTab & "Reversing connector direction to make the start element match the origin class for this RelationshipClass."
				ReverseConnectorDirection con
			End If
		End If
	End If

	' Check the Notification tag. Force the connector direction to match. Then set the tag to use the connector value.
	Set tag = GetTagByName(con.TaggedValues, "Notification")
	If Not tag Is Nothing Then
		If tag.Value = "esriRelNotificationBackward" Then
			con.Direction = "Destination -> Source"
		ElseIf tag.Value = "esriRelNotificationBoth" Then
			con.Direction = "Bi-Directional"
		ElseIf tag.Value = "esriRelNotificationForward" Then
			con.Direction = "Source -> Destination"
		Else
			con.Direction = "Unspecified"
		End If
		tag.Value = "useUMLConnectorDirection"
		tag.Notes = "Values: esriRelNotificationBackward,esriRelNotificationBoth,esriRelNotificationForward,esriRelNotificationNone,useUMLConnectorDirection" & VBCRLF & "Default: useUMLConnectorDirection" & VBCRLF
		tag.Update
	Else
		con.Direction = "Unspecified"
		SetTagValByNameEx con.TaggedValues, "Notification", "useUMLConnectorDirection", "Values: esriRelNotificationBackward,esriRelNotificationBoth,esriRelNotificationForward,esriRelNotificationNone,useUMLConnectorDirection" & VBCRLF & "Default: useUMLConnectorDirection" & VBCRLF
	End If

	' IsAttributed was used in Visio to flag whether the relationship has a corresponding class that defines attributes.
	' This tag is redundant in Enterprise Architect. Its value is determined automatically by the schema generator as follows:
	' If the connector has an AssociationClass, IsAttributed is true, otherwise false (ie. a binary Association connector).
	RemoveTagByName con.TaggedValues, "IsAttributed"

' The following tags get set automatically later via the call to SynchProfile "ArcGIS", "RelationshipClass"

'	SetTagValByNameEx con.TaggedValues, "KeyType", "esriRelKeyTypeSingle", "Values: esriRelKeyTypeDual,esriRelKeyTypeSingle" & VBCRLF & "Default: esriRelKeyTypeSingle" & VBCRLF
'	SetTagValByNameEx con.TaggedValues, "ClassKey", "esriRelClassKeyUndefined", "Values: esriRelClassKeyClassCode,esriRelClassKeyClassID,esriRelClassKeyUndefined" & VBCRLF & "Default: esriRelClassKeyUndefined" & VBCRLF
'	SetTagValByNameEx con.TaggedValues, "IsComposite", "false", "Values: true,false" & VBCRLF & "Default: false" & VBCRLF
'	SetTagValByNameEx con.TaggedValues, "IsReflexive", "false", "Values: true,false" & VBCRLF & "Default: false" & VBCRLF
'	SetTagValByNameEx con.TaggedValues, "DatasetType", "esriDTRelationshipClass", "Values: esriDTAny,esriDTCadastralFabric,esriDTCadDrawing,esriDTContainer,esriDTFeatureClass,esriDTGeo,esriDTGeometricNetwork,esriDTLocator,esriDTNetworkDataset,esriDTPlanarGraph,esriDTRasterBand,esriDTRasterCatalog,esriDTRasterDataset,esriDTRelationshipClass,esriDTRepresentationClass,esriDTSchematicDataset,esriDTTable,esriDTTerrain,esriDTText,esriDTTin,esriDTTool,esriDTToolbox,esriDTTopology,esriDTFeatureDataset" & VBCRLF & "Default: esriDTRelationshipClass" & VBCRLF
'	SetTagValByNameEx con.TaggedValues, "OIDFieldName", "", ""
'	SetTagValByNameEx con.TaggedValues, "DSID", "-1", "Default: -1"
'	SetTagValByNameEx con.TaggedValues, "ModelName", "", ""
'	SetTagValByNameEx con.TaggedValues, "GlobalIDFieldName", "", ""
'	SetTagValByNameEx con.TaggedValues, "CatalogPath", "", ""
'	SetTagValByNameEx con.TaggedValues, "RasterFieldName", "", ""
'	SetTagValByNameEx con.TaggedValues, "Versioned", "false", "Values: true,false" & VBCRLF & "Default: false" & VBCRLF
'	SetTagValByNameEx con.TaggedValues, "CanVersion", "false", "Values: true,false" & VBCRLF & "Default: false" & VBCRLF
'	SetTagValByNameEx con.TaggedValues, "MetadataRetrieved", "false", "Values: true,false" & VBCRLF & "Default: false" & VBCRLF
'	SetTagValByNameEx con.TaggedValues, "Metadata", "", ""

	Set AddRelationshipClassTags = relClass

End Function

Sub ProcessRelClassField(con, field, val, atts)

	Dim att As EA.Attribute
	Set att = GetAttByName(atts, val)
	If att Is Nothing Then
		' Try again for a case insensitive match. If a match is found raise a warning
		Dim idx
		For idx = 0 To atts.Count - 1
			Set att = atts.GetAt(idx)
			If Not att Is Nothing Then
				If LCase(att.Name) = LCase(val) Then
					Exit For
				End If
				Set att = Nothing
			End If
		Next

		If Not att Is Nothing Then
			Session.Output VbTab & "Warning: Detected difference in case between the OriginForeignKey tag value ("&val&") and the Association Class field name( "&att.Name&"). Setting the tag value to match Association Class field."
			SetTagValByNameEx con.TaggedValues, field, att.AttributeGUID, ""
		Else
			Session.Output VbTab & "Error: Could not locate " & field & " field named: " & val
			SetTagValByNameEx con.TaggedValues, field, "", ""
		End If
	Else
		SetTagValByNameEx con.TaggedValues, field, att.AttributeGUID, ""
	End If

End Sub

' Returns True if role has the form: "End<number>"
' Visio XMI exports association ends with autogenerated names that take this form. It is not useful.
Function IsRoleAutoNamed(role)
	Dim ret
	ret = False

	If Len(role) > 3 Then
		Dim suffix, prefix
		prefix = Left(role, 3)
		suffix = Mid(role, 4)
		If prefix = "End" And IsNumeric(suffix) Then
			ret = True
		End If
	End If

	IsRoleAutoNamed = ret

End Function

' Visio's XMI exporter auto-generates connector names. This function guestimates which names are autogenerated.
' Returns True, if name has one of these forms:
'	"AnyName<number>"
'	"Generalization<number>"
'	"Association<number>"
'	"<name>-><name>"
' Returns False, otherwise.
Function IsConAutoNamed(name)
	Dim ret
	ret = False

	If Len(name) > 0 Then
		Dim pos, suffix, char
		pos = Len(name)
		Do Until pos = 0
			char = Mid(name, pos, 1)
			If IsNumeric(char) Then
				suffix = char + suffix
				pos = pos - 1
			Else
				pos = 0
			End If
		Loop

		If Len(suffix) > 0 Then
			Dim prefix
			prefix = Left(name, Len(name) - Len(suffix))
			' Note: A connector name that entirely numeric, indicates a spurious connector created via the Visio Importer.
			' It is not considered autonamed for the purpose of this function.
			If prefix = "AnyName" Or prefix = "Generalization" Or prefix = "Association" Then
				ret = True
			End If
		Else
			pos = Instr(1, name, "->")
			If pos > 0 Then
				ret = True
			End If
		End If
	End If

	IsConAutoNamed = ret
End Function


Function IsFeatureClassStereotype(stereotype)
	Dim ret
	ret = False
	If stereotype = "Point" Or stereotype = "Polyline" Or stereotype = "Polygon" Or stereotype = "MultiPoint" Then
		ret = True
	End If
	IsFeatureClassStereotype = ret
End Function

' If the connector stereotype is set, an extraneous label remains if the connector name is cleared. Possibly a consequence of importing from Visio.
' The CustomCommand clears the connector's Top_Mid_Label
Sub ClearTopMidLabel(con)
	If Not con Is Nothing Then
		CustomCommand "VisioImporter", "UpdateConnectorLabel", "ID="&con.ConnectorID&";"
	End If
End Sub

Sub CleanClassesDiagram(dgm)
	If Not dgm Is Nothing Then
		Session.Output "Cleaning up the ArcInfo 'Esri Classes Diagram'..."
		' Hide Additional Parents on the diagram - these were not shown in the original Visio template
		Dim style
		style = dgm.ExtendedStyle
		ChangeElStyle style, "HideParents", "1"
		dgm.ExtendedStyle = style

		' Update element positions
		' Hide interface attributes and operations and owned connectors on this diagram
		Dim idx, idxCon
		Dim obj As EA.DiagramObject
		Dim con As EA.DiagramLink
		For idx = 0 To dgm.DiagramObjects.Count - 1
			Set obj = dgm.DiagramObjects.GetAt(idx)
			If Not obj Is Nothing Then
				Dim el As EA.Element
				Set el = GetElementByID(obj.ElementID)
				Session.Output VbTab & "Updating diagram element named: " + el.Name + ", of type: " + el.Type

				' Must update positions of obj here. SQL calls are made later by HideInterfaceDetails which invalidate obj behind the scenes.
				SetClassDgmPositions obj, el
				If el.Type = "Interface" Then
					' We only get away with doing this after settings the diagram positions because the diagram display is not updated in this loop.
					' Otherwise the interface attributes/operations would stretch the element and invalidate the positions set above.
					HideInterfaceDetails(obj)

					' Now hide the interface connectors
					For idxCon = 0 To dgm.DiagramLinks.Count - 1
						Set con = dgm.DiagramLinks.GetAt(idxCon)
						If Not con Is Nothing Then
							If IsOwnedConnector(el.ElementID, con.ConnectorID) And con.IsHidden = False Then
								Session.Output VbTab & VbTab & "Hiding diagram link owned by : " + el.Name + " . Connector ID: " & con.ConnectorID
								con.IsHidden = True
								con.Update
							End If
						End If
					Next
				End If
			End If
		Next

		' Now tidy up the connecotors
		Dim conInfo As EA.Connector
		Dim startEl As EA.Element
		Dim endEl As EA.Element
		For idxCon = 0 To dgm.DiagramLinks.Count - 1
			Set con = dgm.DiagramLinks.GetAt(idxCon)
			Set conInfo = GetConnectorByID(con.ConnectorID)
			If Not conInfo Is Nothing Then
				' Remove any connector virtualization, as the hardcoded geometry doesn't require virtualized ends...
				Dim vEnd : vEnd = dgm.VirtualizedEnd(con.ConnectorID)
				If vEnd <> 0 Then
					If vEnd = conInfo.ClientID Then
						dgm.VirtualizeConnector con.ConnectorID, vcSource, 0, 0
					ElseIf vEnd = conInfo.SupplierID Then
						dgm.VirtualizeConnector con.ConnectorID, vcTarget, 0, 0
					End If
				End If
				Set startEl = GetElementByID(conInfo.ClientID)
				Set endEl = GetElementByID(conInfo.SupplierID)
				If Not startEl Is Nothing And Not endEl Is Nothing Then
					SetClassesDiagramLinkGeometry con, startEl.Name, endEl.Name
				End If
			End If
		Next
		dgm.Update

		' This call deals with duplicate connector geometry
		' Note: the reference to dgm.DiagramLinks becomes invalid after the call
		CustomCommand "VisioImporter", "UpdateDiagramLinks", "ID="&dgm.DiagramID&";"

		Session.Output VbTab & "... completed clean up of the ArcInfo 'Esri Classes Diagram'."
	End If
End Sub

Sub CleanInterfacesDiagram(dgm)
	If Not dgm Is Nothing Then
		Session.Output "Cleaning up the ArcInfo 'Esri Interfaces Diagram'..."

		Dim idx, idxCon
		Dim obj As EA.DiagramObject
		Dim con As EA.DiagramLink
		For idx = 0 To dgm.DiagramObjects.Count - 1
			Set obj = dgm.DiagramObjects.GetAt(idx)
			If Not obj Is Nothing Then
				Dim el As EA.Element
				Set el = GetElementByID(obj.ElementID)
				Session.Output VbTab & "Updating diagram element named: " + el.Name + ", of type: " + el.Type
				SetInterfaceDgmPositions obj, el
				' The Visio import seems to create double spacing for text in some Note elements
				If el.Type = "Note" Then
					el.Notes = SingleSpaceDiagramNotes(el.Notes)
					el.Update
				End If
			End If
		Next

		' Now tidy up the connecotors
		Dim conInfo As EA.Connector
		Dim startEl As EA.Element
		Dim endEl As EA.Element
		For idxCon = 0 To dgm.DiagramLinks.Count - 1
			Set con = dgm.DiagramLinks.GetAt(idxCon)
			If Not con Is Nothing Then
				Set conInfo = GetConnectorByID(con.ConnectorID)
				If Not conInfo Is Nothing Then
					Set startEl = GetElementByID(conInfo.ClientID)
					Set endEl = GetElementByID(conInfo.SupplierID)
					If Not startEl Is Nothing And Not endEl Is Nothing Then
						SetInterfaceDiagramLinkGeometry con, startEl.Name, endEl.Name
					End If
				End If
			End If
		Next
		dgm.Update
		Session.Output VbTab & "... completed clean up of ArcInfo 'Esri Interfaces Diagram'."
	End If
End Sub

Sub CleanNetworkDiagram(dgm)
	If Not dgm Is Nothing Then
		Session.Output "Cleaning up the ArcInfo 'ESRI Generic Junction Diagram'..."

		Dim idx, idxCon
		Dim obj As EA.DiagramObject
		Dim con As EA.DiagramLink
		For idx = 0 To dgm.DiagramObjects.Count - 1
			Set obj = dgm.DiagramObjects.GetAt(idx)
			If Not obj Is Nothing Then
				Dim el As EA.Element
				Set el = GetElementByID(obj.ElementID)
				Session.Output VbTab & "Updating diagram element named: " + el.Name + ", of type: " + el.Type
				SetNetworkDgmPositions obj, el
				' The Visio import seems to create double spacing for text in some Note elements
				If el.Type = "Note" Then
					el.Notes = SingleSpaceDiagramNotes(el.Notes)
					el.Update
				End If
			End If
		Next

		' Now tidy up the connecotors
		Dim conInfo As EA.Connector
		Dim startEl As EA.Element
		Dim endEl As EA.Element
		For idxCon = 0 To dgm.DiagramLinks.Count - 1
			Set con = dgm.DiagramLinks.GetAt(idxCon)
			If Not con Is Nothing Then
				Set conInfo = GetConnectorByID(con.ConnectorID)
				If Not conInfo Is Nothing Then
					Set startEl = GetElementByID(conInfo.ClientID)
					Set endEl = GetElementByID(conInfo.SupplierID)
					If Not startEl Is Nothing And Not endEl Is Nothing Then
						SetNetworkDiagramLinkGeometry con, startEl.Name, endEl.Name
					End If
				End If
			End If
		Next
		dgm.Update
		Session.Output VbTab & "... completed clean up of ArcInfo 'ESRI Generic Junction Diagram'."	
	End If	
End Sub

' Can't get at the diagram object display options via API directly - use SQL instead
Sub HideInterfaceDetails(dgmObj)
	If Not dgmObj Is Nothing Then
		' Note: We just leave the RZO style setting as-is. (It determines how EA wraps, truncates or stretches elements) based on property sizes
		CustomCommand "VisioImporter", "UpdateStyle", "ID="&dgmObj.InstanceID&";style=AttPro,0,AttPri,0,AttPub,0,AttPkg,0,OpPro,0,OpPri,0,OpPub,0,OpPkg,0;"
	End If
End Sub

' We know what the ArcInfo "Classes" diagram should look like, so this just hard codes the element positions, based on the name
' obj: the diagram object to reposition and resize
' el:  the model element that obj represents on the diagram
' The geometry info for this model was retrived from a reference ArcInfo model in EA using the following query:
' SELECT t_object.Name, t_diagramobjects.RectLeft, t_diagramobjects.RectRight, t_diagramobjects.RectTop, t_diagramobjects.RectBottom FROM t_object, t_diagramobjects, t_diagram WHERE t_diagramobjects.Object_ID = t_object.Object_ID AND t_diagramobjects.Diagram_ID = t_diagram.Diagram_ID AND t_diagram.Name = "ESRI Classes Diagram"
Sub SetClassDgmPositions(obj, el)

	Dim aryEls
	aryEls = Array("ClassExtension,421,511,-48,-118",_
"ComplexEdgeFeature,2010,2123,-1219,-1289",_
"ComplexJunctionFeature,1036,1166,-1248,-1318",_
"EdgeFeature,2294,2384,-1068,-1138",_
"Feature,1596,1772,-657,-727",_
"FeatureClassExtension,405,527,-570,-640",_
"IClassExtension,664,894,-57,-97",_
"IComplexEdgeFeature,1673,1896,-1280,-1320",_
"IComplexJunctionFeature,1347,1570,-1234,-1274",_
"IComplexNetworkFeature,1347,1570,-1175,-1215",_
"IConfirmSendRelatedObjectEvents,15,300,-334,-374",_
"IEdgeFeature,2552,2775,-1084,-1124",_
"IFeature,1900,2123,-595,-635",_
"IFeatureBuffer,1900,2123,-665,-705",_
"IFeatureChanges,1266,1489,-732,-772",_
"IFeatureClassCreation,664,887,-657,-697",_
"IFeatureClassDraw,664,887,-729,-769",_
"IFeatureClassEdit,79,300,-572,-612",_
"IFeatureClassExtension,664,887,-586,-626",_
"IFeatureConnect,1347,1570,-1366,-1406",_
"IFeatureDraw,1266,1489,-594,-634",_
"IFeatureEdit,1266,1489,-665,-705",_
"IFeatureEvents,1900,2123,-732,-772",_
"IFeatureSnap,1347,1570,-1306,-1346",_
"IJunctionFeature,447,670,-1077,-1117",_
"INetworkFeature,1266,1489,-837,-877",_
"INetworkFeatureEvents,1900,2123,-837,-877",_
"IObject,1900,2051,-388,-428",_
"IObjectClassEvents,113,300,-405,-445",_
"IObjectClassExtension,664,887,-285,-325",_
"IObjectClassValidation,664,887,-346,-386",_
"IObjectInspector,123,300,-266,-306",_
"IRelatedObjectClassEvents,664,897,-406,-446",_
"IRelatedObjectClassEvents2,664,918,-466,-506",_
"IRelatedObjectEvents,1294,1489,-296,-336",_
"IRow,1370,1489,-233,-273",_
"IRowBuffer,1900,2060,-106,-146",_
"IRowChanges,1329,1489,-41,-81",_
"IRowEdit,1349,1489,-170,-210",_
"IRowEvents,1336,1489,-106,-146",_
"IRowSubtypes,1900,2060,-41,-81",_
"ISimpleEdgeFeature,2663,2886,-1223,-1263",_
"ISimpleJunctionFeature,447,670,-1222,-1262",_
"ISimpleNetworkFeature,447,670,-1279,-1319",_
"IValidate,1900,2060,-170,-210",_
"JunctionFeature,792,1186,-1063,-1132",_
"NetworkFeature,1584,1784,-819,-889",_
"Object,1582,1786,-374,-446",_
"ObjectClassExtension,408,524,-270,-340",_
"Row,1639,1729,-110,-180",_
"SimpleEdgeFeature,2482,2586,-1219,-1289",_
"SimpleJunctionFeature,757,878,-1248,-1318")

	SetDgmPositions aryEls, obj, el

End Sub

' The geometry info for this model was retrived from a reference ArcInfo model in EA using the following query:
' SELECT obj1.Name AS startEl , obj2.Name AS endEl, t_diagramlinks.Geometry, t_diagramlinks.Style, t_diagramlinks.Path FROM t_object AS obj1, t_object AS obj2, t_connector, t_diagramlinks, t_diagram WHERE t_diagramlinks.ConnectorID = t_connector.Connector_ID AND t_diagramlinks.DiagramID = t_diagram.Diagram_ID AND t_diagram.Name = 'ESRI Classes Diagram' AND t_connector.Start_Object_ID = obj1.Object_ID AND t_connector.End_Object_ID = obj2.Object_ID
Sub SetClassesDiagramLinkGeometry(dgmLink, startEl, endEl)
	Dim aryGeoms
	aryGeoms = Array("ClassExtension,IClassExtension,SX=44;SY=6;EX=-1;EY=0;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=79B16DE8;SOID=488D312B;Color=-1;LWidth=0;, ,",_
"ComplexEdgeFeature,IComplexEdgeFeature,SX=-37;SY=-12;EX=-26;EY=-4;EDGE=4;$LLB=;LLT=;LMT=;LMB=CX=39:CY=13:OX=8:OY=-32:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=0:DIR=0:ROT=0;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=B656440B;SOID=FB24DDB3;Color=-1;LWidth=0;TREE=OS;,1971:-1276;1971:-1302;,",_
"ComplexEdgeFeature,EdgeFeature,SX=0;SY=0;EX=1;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=88C147CD;SOID=FB24DDB3;Color=-1;LWidth=0;TREE=V;,2066:-1188;2339:-1188;,",_
"ComplexEdgeFeature,IComplexNetworkFeature,SX=-55;SY=15;EX=111;EY=-2;EDGE=4;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=F447347C;SOID=FB24DDB3;Color=-1;LWidth=0;,1762:-1238;1762:-1197;,",_
"ComplexJunctionFeature,IFeatureSnap,SX=5;SY=-13;EX=-1;EY=2;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=30:OY=13:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=8B09BCCB;SOID=19589497;Color=-1;LWidth=0;,1212:-1296;1212:-1324;,",_
"ComplexJunctionFeature,IComplexJunctionFeature,SX=1;SY=9;EX=-1;EY=0;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=34:OY=-11:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=579D6EC0;SOID=19589497;Color=-1;LWidth=0;,1211:-1272;1211:-1253;,",_
"ComplexJunctionFeature,JunctionFeature,SX=0;SY=0;EX=0;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=0E54A575;SOID=19589497;Color=-1;LWidth=0;TREE=V;,1100:-1182;989:-1182;,",_
"ComplexJunctionFeature,IFeatureConnect,SX=42;SY=-32;EX=1;EY=-17;EDGE=3;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=61A02C4A;SOID=19589497;Color=-1;LWidth=0;TREE=OS;,1143:-1383;,",_
"ComplexJunctionFeature,IComplexNetworkFeature,SX=40;SY=34;EX=0;EY=0;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=F447347C;SOID=19589497;Color=-1;LWidth=0;,1141:-1195;,",_
"EdgeFeature,IEdgeFeature,SX=43;SY=0;EX=0;EY=0;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=1D457072;SOID=88C147CD;Color=-1;LWidth=0;TREE=OS;, ,",_
"EdgeFeature,NetworkFeature,SX=0;SY=0;EX=0;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=A32492C3;SOID=88C147CD;Color=-1;LWidth=0;TREE=V;,2339:-939;1684:-939;,",_
"Feature,IFeatureEvents,SX=56;SY=-1;EX=1;EY=-3;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=31:OY=15:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=A2E58513;SOID=76114185;Color=-1;LWidth=0;TREE=OS;,1795:-709;1795:-750;,",_
"Feature,IFeatureBuffer,SX=65;SY=4;EX=-1;EY=-3;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=7BAA3703;SOID=76114185;Color=-1;LWidth=0;, ,",_
"Feature,IFeatureChanges,SX=-33;SY=-3;EX=-7;EY=-14;EDGE=4;$LLB=;LLT=;LMT=CX=43:CY=13:OX=-31:OY=12:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=95756467;SOID=76114185;Color=-1;LWidth=0;TREE=OS;,1572:-712;1572:-753;,",_
"Feature,IFeature,SX=-19;SY=1;EX=-2;EY=12;EDGE=1;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=55E8028D;SOID=76114185;Color=-1;LWidth=0;TREE=OS;,1735:-623;,",_
"Feature,Object,SX=0;SY=-31;EX=0;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=3026DB97;SOID=76114185;Color=-1;LWidth=0;, ,",_
"Feature,IFeatureDraw,SX=-39;SY=0;EX=-18;EY=11;EDGE=1;$LLB=;LLT=;LMT=;LMB=CX=39:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=0:DIR=0:ROT=0;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=ABCBF583;SOID=4DD36D23;Color=-1;LWidth=0;TREE=OS;,1632:-623;,",_
"Feature,IFeatureEdit,SX=0;SY=0;EX=1;EY=0;EDGE=4;$LLB=;LLT=;LMT=CX=43:CY=13:OX=9:OY=-1:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=BD2943ED;SOID=76114185;Color=-1;LWidth=0;TREE=OS;, ,",_
"FeatureClassExtension,ObjectClassExtension,SX=0;SY=0;EX=0;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=3A10068D;SOID=6EC1440A;Color=-1;LWidth=0;, ,",_
"FeatureClassExtension,IFeatureClassExtension,SX=1;SY=-1;EX=-1;EY=0;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=ED86C3D3;SOID=555BDE16;Color=-1;LWidth=0;, ,",_
"IFeature,IObject,EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=2;EOID=296A1BD9;SOID=55E8028D;Color=-1;LWidth=0;, ,",_
"IFeatureBuffer,IRowBuffer,EDGE=1;SX=-28;SY=2;EX=-28;EY=2;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=2;EOID=67769336;SOID=7BAA3703;Color=-1;LWidth=0;, ,",_
"IFeatureEdit,IRowEdit,EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=2;EOID=93EBB5A4;SOID=BD2943ED;Color=-1;LWidth=0;, ,",_
"IObject,IRow,EDGE=4;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=2;EOID=36B2B979;SOID=296A1BD9;Color=-1;LWidth=0;, ,",_
"IRow,IRowBuffer,EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=2;EOID=67769336;SOID=36B2B979;Color=-1;LWidth=0;, ,",_
"JunctionFeature,IJunctionFeature,SX=-1;SY=-1;EX=1;EY=0;EDGE=4;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=E05A02B6;SOID=0E54A575;Color=-1;LWidth=0;, ,",_
"JunctionFeature,NetworkFeature,SX=0;SY=0;EX=0;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=A32492C3;SOID=0E54A575;Color=-1;LWidth=0;TREE=V;,988:-939;1684:-939;,",_
"NetworkFeature,Feature,SX=0;SY=-32;EX=0;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=76114185;SOID=A32492C3;Color=-1;LWidth=0;, ,",_
"NetworkFeature,INetworkFeatureEvents,SX=1;SY=0;EX=0;EY=0;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=6AF4D891;SOID=A32492C3;Color=-1;LWidth=0;TREE=OS;, ,",_
"NetworkFeature,INetworkFeature,SX=-99;SY=-3;EX=15;EY=0;EDGE=4;$LLB=;LLT=;LMT=CX=43:CY=13:OX=6:OY=-3:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=1;EOID=2D5B68D5;SOID=A32492C3;Color=-1;LWidth=0;,1384:-889;,",_
"Object,IObject,SX=47;SY=6;EX=1;EY=4;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=4:OY=-1:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=296A1BD9;SOID=3026DB97;Color=-1;LWidth=0;, ,",_
"Object,Row,SX=3;SY=35;EX=3;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=3356B65A;SOID=3026DB97;Color=-1;LWidth=0;, ,",_
"ObjectClassExtension,IObjectClassExtension,SX=1;SY=-1;EX=-1;EY=-1;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=73B89027;SOID=66FD91E6;Color=-1;LWidth=0;, ,",_
"ObjectClassExtension,ClassExtension,SX=0;SY=0;EX=1;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=9F9529D2;SOID=3A10068D;Color=-1;LWidth=0;, ,",_
"Row,IValidate,SX=45;SY=-35;EX=1;EY=20;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=28:OY=10:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=54A6DC9B;SOID=3356B65A;Color=-1;LWidth=0;TREE=OS;,1789:-169;1789:-193;,",_
"Row,IRowChanges,SX=34;SY=34;EX=13;EY=20;EDGE=1;$LLB=;LLT=;LMT=CX=43:CY=13:OX=-1:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=8C74F332;SOID=3356B65A;Color=-1;LWidth=0;TREE=OS;,1657:-60;,",_
"Row,IRowEvents,SX=-1;SY=13;EX=-1;EY=12;EDGE=4;$LLB=;LLT=;LMT=CX=43:CY=13:OX=4:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=26353D6D;SOID=3356B65A;Color=-1;LWidth=0;TREE=OS;, ,",_
"Row,IRowBuffer,SX=4;SY=15;EX=34;EY=2;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=67769336;SOID=3356B65A;Color=-1;LWidth=0;TREE=OS;, ,",_
"Row,IRowEdit,SX=-43;SY=-35;EX=-1;EY=-11;EDGE=3;$LLB=;LLT=;LMT=CX=43:CY=13:OX=-1:OY=-11:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=93EBB5A4;SOID=3356B65A;Color=-1;LWidth=0;TREE=OS;,1557:-173;1557:-191;,",_
"Row,IRow,SX=-17;SY=-32;EX=9;EY=-12;EDGE=3;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=36B2B979;SOID=3356B65A;Color=-1;LWidth=0;TREE=OS;,1657:-255;,",_
"Row,IRelatedObjectEvents,SX=-22;SY=-32;EX=0;EY=-12;EDGE=3;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=7BE7CF48;SOID=3356B65A;Color=-1;LWidth=0;TREE=OS;,1657:-309;,",_
"Row,IRowSubtypes,SX=-9;SY=-3;EX=-22;EY=1;EDGE=1;$LLB=;LLT=;LMT=CX=43:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=FC4C7464;SOID=3356B65A;Color=-1;LWidth=0;TREE=OS;,1710:-61;,",_
"SimpleEdgeFeature,EdgeFeature,SX=0;SY=0;EX=0;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=88C147CD;SOID=D8B458AC;Color=-1;LWidth=0;TREE=V;,2534:-1188;2339:-1188;,",_
"SimpleEdgeFeature,ISimpleEdgeFeature,SX=3;SY=11;EX=-21;EY=20;EDGE=2;$LLB=;LLT=;LMT=CX=43:CY=13:OX=-4:OY=-1:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=01BF54F2;SOID=D8B458AC;Color=-1;LWidth=0;TREE=OS;, ,",_
"SimpleEdgeFeature,ISimpleNetworkFeature,SX=-51;SY=-7;EX=71;EY=-4;EDGE=4;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=EA92D44E;SOID=D8B458AC;Color=-1;LWidth=0;,2255:-1260;2255:-1441;629:-1441;,",_
"SimpleJunctionFeature,JunctionFeature,SX=0;SY=0;EX=1;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=0E54A575;SOID=B3E027D6;Color=-1;LWidth=0;TREE=V;,816:-1182;989:-1182;,",_
"SimpleJunctionFeature,ISimpleNetworkFeature,SX=-58;SY=-19;EX=-32;EY=-2;EDGE=4;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=EA92D44E;SOID=B3E027D6;Color=-1;LWidth=0;, ,",_
"SimpleJunctionFeature,ISimpleJunctionFeature,SX=-1;SY=16;EX=1;EY=0;EDGE=4;$LLB=;LLT=;LMT=CX=43:CY=13:OX=-22:OY=-14:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=1:DIR=0:ROT=0;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=718D1E4A;SOID=B3E027D6;Color=-1;LWidth=0;,734:-1265;734:-1240;,")

	SetDiagramLinkGeometries aryGeoms, dgmLink, startEl, endEl
End Sub

Sub SetInterfaceDgmPositions(obj, el)
	Dim aryEls
	aryEls = Array(",875,1025,-138,-198,",_
"IFeature,364,598,-756,-859,",_
"IFeatureBuffer,708,836,-377,-454,",_
"IFeatureEdit,68,314,-377,-517,",_
"IObject,409,553,-603,-681,",_
"IRow,392,570,-377,-517,",_
"IRowBuffer,377,585,-170,-277,",_
"IRowEdit,127,255,-170,-247,",_
"IRowSubtypes,701,843,-170,-247,",_
"IUnknown,412,550,-20,-86,")

	SetDgmPositions aryEls, obj, el
End Sub

Sub SetInterfaceDiagramLinkGeometry(dgmLink, startEl, endEl)
	Dim aryGeoms
	aryGeoms = Array("IFeature,IObject,SX=0;SY=0;EX=1;EY=-1;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=1;EOID=16FACB81;SOID=7A6192A3;Color=-1;LWidth=0;,481:-800;481:-800;,",_
"IFeatureBuffer,IRowBuffer,SX=0;SY=0;EX=0;EY=36;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=EDBB2801;SOID=BD5DFC1C;Color=-1;LWidth=0;TREE=V;,771:-327;481:-327;,",_
"IFeatureEdit,IRowEdit,SX=0;SY=-37;EX=0;EY=-1;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=1;EOID=575CA70A;SOID=758E264E;Color=-1;LWidth=0;, ,",_
"IObject,IRow,SX=0;SY=0;EX=0;EY=37;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=1;EOID=62966C4C;SOID=16FACB81;Color=-1;LWidth=0;,481:-617;481:-617;,",_
"IRow,IRowBuffer,SX=0;SY=0;EX=0;EY=-1;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=EDBB2801;SOID=62966C4C;Color=-1;LWidth=0;TREE=V;,481:-327;481:-327;,",_
"IRowBuffer,IUnknown,SX=0;SY=0;EX=0;EY=-1;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=4D702C34;SOID=EDBB2801;Color=-1;LWidth=0;TREE=V;,481:-136;481:-136;,",_
"IRowEdit,IUnknown,SX=0;SY=0;EX=0;EY=-1;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=4D702C34;SOID=575CA70A;Color=-1;LWidth=0;TREE=V;,189:-136;481:-136;,",_
"IRowSubtypes,IUnknown,SX=0;SY=0;EX=0;EY=-1;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=4D702C34;SOID=9AC4E3FD;Color=-1;LWidth=0;TREE=V;,770:-136;481:-136;,")

	SetDiagramLinkGeometries aryGeoms, dgmLink, startEl, endEl
End Sub

Sub SetNetworkDgmPositions(obj, el)
	Dim aryEls
	aryEls = Array(",481,711,-157,-285,",_
"GenericJunction,216,328,-277,-343,",_
"GenericJunctionST,207,337,-456,-523,",_
"SimpleJunctionFeature,150,394,-123,-190,")

	SetDgmPositions aryEls, obj, el
End Sub

Sub SetNetworkDiagramLinkGeometry(dgmLink, startEl, endEl)
	Dim aryGeoms
	aryGeoms = Array("GenericJunction,SimpleJunctionFeature,SX=1;SY=-32;EX=1;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=04CAF9C4;SOID=9C0D489E;Color=-1;LWidth=0;, ,",_
"GenericJunctionST,GenericJunction,SX=1;SY=-31;EX=1;EY=31;EDGE=1;$LLB=;LLT=;LMT=;LMB=CX=51:CY=13:OX=0:OY=0:HDN=0:BLD=0:ITA=0:UND=0:CLR=-1:ALN=0:DIR=0:ROT=0;LRT=;LRB=;IRHS=;ILHS=;,Mode=3;EOID=9C0D489E;SOID=1394E6C6;Color=-1;LWidth=0;, ,")

	SetDiagramLinkGeometries aryGeoms, dgmLink, startEl, endEl
End Sub

' aryEls must be of the form: <element_name>, <left>, <right>, <top>, <bottom>
Sub SetDgmPositions(aryEls, obj, el)

	Dim line
	For Each line In aryEls
		If Len(line) > 0 Then
			Dim aryVals
			aryVals = Split(line, ",")
			If aryVals(0) = el.Name Then
				SetObjPos Obj, aryVals(1), aryVals(2), aryVals(3), aryVals(4)
			End If
		Else
			Session.Output "Found zero-length geometry for Element: " + el.Name
		End If
	Next

	obj.Update

End Sub

' aryGeoms must be of the form: <start_element>, <end_element>, <geometry>, <style>, <path>
Sub SetDiagramLinkGeometries(aryGeoms, dgmLink, startEl, endEl)

	Dim line
	For Each line In aryGeoms
		If Len(line) > 0 Then
			Dim aryVals
			aryVals = Split(line, ",")
			If aryVals(0) = startEl And aryVals(1) = endEl Then
				SetDiagramLinkGeometry dgmLink, aryVals(2), aryVals(3), aryVals(4)
			End If
		Else
			Session.Output "Found zero-length geometry for Elements: " + startEl + ", " + endEl
		End If
	Next

	dgmLink.Update

End Sub

Sub SetObjPos(obj, left, right, top, bottom)
	obj.left = left
	obj.right = right
	obj.top = top
	obj.bottom = bottom
End Sub

Sub SetDiagramLinkGeometry(dgmLink, geom, style, path)
	dgmLink.Geometry = geom
	dgmLink.Style = style
	dgmLink.Path = path
End Sub

' Strip all double spaces except after a period (.)
Function SingleSpaceDiagramNotes(notes)
	notes = Replace(notes, VbCrLf+VbCrLf, VbCrLf)
	SingleSpaceDiagramNotes = notes
End Function

' Changes the stereotype of pkg to stereo and synchs tags with the ArcGIS profile.
' If the existing stereotype matches stereo, calls SynchTaggedValues to force the synch.
Sub ApplyPkgStereotype(pkg, stereo)

	Dim oldStereo: OldStereo = pkg.StereotypeEx
	pkg.Element.Stereotype = stereo
	pkg.StereotypeEx = stereo
	If oldStereo = stereo Then
		pkg.Element.SynchTaggedValues "ArcGIS", stereo
		pkg.Element.TaggedValues.Refresh
	Else
		pkg.Update ' This Update call saves the stereotype change and adds missing ArcGIS tags
	End If

End Sub


''''''''''''''''''''''''''''''''''''''
'' Helper Functions
''''''''''''''''''''''''''''''''''''''

Function GetTagByName(tags, name)

	Dim i
	Dim tag As EA.TaggedValue
	Set tag = Nothing
	If Not tags Is Nothing Then
		For i = 0 To tags.Count - 1
			If tags.GetAt(i).Name = name Then
				Set tag = tags.GetAt(i)
				Exit For
			End If
		Next
	End If
	Set GetTagByName = tag

End Function

Function GetTagByNameNoCase(tags, name)

	Dim i
	Dim tag As EA.TaggedValue
	Set tag = Nothing
	If Not tags Is Nothing Then
		For i = 0 To tags.Count - 1
			If LCase(tags.GetAt(i).Name) = LCase(name) Then
				Set tag = tags.GetAt(i)
				Exit For
			End If
		Next
	End If
	Set GetTagByNameNoCase = tag

End Function

Function GetTagValByName(tags, name)

	Dim ret
	ret = ""

	If Not tags Is Nothing Then
		Dim i
		Dim tag As EA.TaggedValue
'		Set tag = tags.GetByName(name)
		For i = 0 To tags.Count - 1
			If tags.GetAt(i).Name = name Then
				ret = tags.GetAt(i).Value
				Exit For
			End If
		Next
	End If

	GetTagValByName = ret

End Function

Function GetTagValByNameNoCase(tags, name)

	Dim ret
	ret = ""

	If Not tags Is Nothing Then
		Dim i
		Dim tag As EA.TaggedValue
		For i = 0 To tags.Count - 1
			If LCase(tags.GetAt(i).Name) = LCase(name) Then
				ret = tags.GetAt(i).Value
				Exit For
			End If
		Next
	End If

	GetTagValByNameNoCase = ret

End Function

Sub SetTagValByName(tags, name, val)

	If Not tags Is Nothing And Len(name) > 0 Then
		Dim tag As EA.TaggedValue
		Set tag = GetTagByName(tags, name)
		If Not tag Is Nothing Then
			tag.Value = val
			tag.Update
			tags.Refresh
		Else
			Set tag = tags.AddNew(name, val)
			tag.Update
			tags.Refresh
		End If
	End If

End Sub

Sub SetTagValByNameEx(tags, name, val, notes)

	If Not tags Is Nothing And Len(name) > 0 Then
		Dim tag As EA.TaggedValue
'		Set tag = tags.GetByName(name)
		Set tag = GetTagByName(tags, name)
		If Not tag Is Nothing Then
			tag.Value = val
			tag.Notes = notes
			tag.Update
			tags.Refresh
		Else
			Set tag = tags.AddNew(name, val)
			tag.notes = notes
			tag.Update
			tags.Refresh
		End If
	End If

End Sub

Sub RemoveTagByName(tags, name)

	If Not tags Is Nothing Then
		Dim idx
		For idx = 0 To tags.Count - 1
			Dim tag As EA.TaggedValue
			Set tag = tags.GetAt(idx)
			If tag.Name = name Then
				tags.Delete idx
				tags.Refresh
				Exit For
			End If
		Next
	End If

End Sub

Sub RemoveTagByNameNoCase(tags, name)

	If Not tags Is Nothing Then
		Dim idx
		For idx = 0 To tags.Count - 1
			Dim tag As EA.TaggedValue
			Set tag = tags.GetAt(idx)
			If LCase(tag.Name) = LCase(name) Then
				tags.Delete idx
				tags.Refresh
				Exit For
			End If
		Next
	End If

End Sub

Sub DeleteAllTags(tags)

	If Not tags Is Nothing Then
		Dim idx
		For idx = 0 To tags.Count - 1
			tags.DeleteAt idx, false
		Next
		tags.Refresh
	End If

End Sub

' Returns True if elID is the Start element for the connector with ID conID
' Returns Fase otherwise
Function IsOwnedConnector(elID, conID)
	Dim bOwned
	bOwned = False

	Dim sql, ret
	sql = "SELECT Start_Object_ID FROM t_connector WHERE Connector_ID=" & conID
	ret = Repository.SQLQuery(sql)

	If Len(ret) > 0 Then
		Dim id
		id = ExtractFieldValFromXML(ret, "Start_Object_ID")
		If Len(id) > 0 And IsNumeric(id) Then
			If id = CStr(elID) Then
				bOwned = True
			End If
		End If
	End If
	IsOwnedConnector = bOwned
End Function

' Swap the start and end elements associated with conn
' The element with ID startID becomes the end element. The element with ID endID becomes the start element
' Reverses the cardinality and roles names associated with the connector
' Reverses the waypoints associated with the connector geometry on all diagrams
' (Checks whether the diagram links are virtual connectors and handles them as a special case)
' Note: The function first iterates through every diagram where the connector appears to update any virtualization, then does the swap, then reverses geometry
Sub ReverseConnectorDirection(con)

	Dim i, p
	Dim vEnd
	Dim theDiagram As EA.Diagram
	Dim dl As EA.DiagramLink

	'find all existing diagramlinks for this connector
	Dim sql: sql = "Select DiagramID From t_diagramlinks Where ConnectorID="&con.ConnectorID
	Dim diagramIDs : diagramIDs = BuildArrayFromSQL(sql,"DiagramID")

	Dim virtualizedConnectorInfo
	Set virtualizedConnectorInfo = CreateObject("Scripting.Dictionary")

	'Remove any virtualized connector ends before doing the swap
	For i = 0 To UBound(diagramIDs)
		Set theDiagram = Repository.GetDiagramByID( diagramIDs(i) )
		For Each dl In theDiagram.DiagramLinks
			'find the specific connector we are looking for
			If dl.ConnectorID = con.ConnectorID Then
				'if not hidden
				If dl.IsHidden = False Then
					'and contains path information
					If Len(dl.Path) > 0 Then
						'if Virtualized
						vEnd = theDiagram.VirtualizedEnd(con.ConnectorID)
						If vEnd <> 0 Then
							'remove virtualization (we readd it later in the opposite direction)
							If vEnd = con.ClientID Then
								theDiagram.VirtualizeConnector con.ConnectorID, vcSource, 0, 0
							ElseIf vEnd = con.SupplierID Then
								theDiagram.VirtualizeConnector con.ConnectorID, vcTarget, 0, 0
							End If
							theDiagram.Update

							virtualizedConnectorInfo.Add theDiagram.DiagramID, vEnd
						End If
					End If
				End If
			End If
		Next
	Next

	'swap ClientID and SupplierID, Role Names and Multiplicity
	ReverseConnectorInfo con

	'update diagramlink geometry and virtualize connector end again if needed
	For i = 0 To UBound(diagramIDs)
		Set theDiagram = Repository.GetDiagramByID( diagramIDs(i) )
		For Each dl In theDiagram.DiagramLinks
			'find the specific connector we are looking for
			If dl.ConnectorID = con.ConnectorID Then
				'if not hidden
				If dl.IsHidden = False Then
					'and contains path information
					If Len(dl.Path) > 0 Then
						vEnd = theDiagram.VirtualizedEnd(con.ConnectorID)

						'reverse the dl.Path
						Dim originalPathArray : originalPathArray = Split(dl.Path, ";")
						Dim fixedPath : fixedPath = ""

						For p = UBound(originalPathArray)-1 To 0 Step -1
							fixedPath = fixedPath & originalPathArray(p) & ";"
						Next

						'swap SX,SY and EX,EY in dl.Geometry			
						Dim SX : SX = GetValue(GetOption(dl.Geometry, ";", "SX"))
						Dim SY : SY = GetValue(GetOption(dl.Geometry, ";", "SY"))
						Dim EX : EX = GetValue(GetOption(dl.Geometry, ";", "EX"))
						Dim EY : EY = GetValue(GetOption(dl.Geometry, ";", "EY"))

						'if SX, SY, EX or EY are missing, set them as zero
						If SX = "" Then SX = "0"
						If SY = "" Then SY = "0"
						If EX = "" Then EX = "0"
						If EY = "" Then EY = "0"

						Dim style : style = dl.Geometry
						ChangeElStyle style, "SX", EX
						ChangeElStyle style, "SY", EY
						ChangeElStyle style, "EX", SX
						ChangeElStyle style, "EY", SY

						dl.Path = fixedPath
						dl.Geometry = style
						dl.Update

						'add virtualization again (if it was set before)
						If virtualizedConnectorInfo.Exists(theDiagram.DiagramID) Then
							vEnd = CLng(virtualizedConnectorInfo.Item(theDiagram.DiagramID))
							If vEnd = con.ClientID Then
								theDiagram.VirtualizeConnector con.ConnectorID, vcSource, 0, 0
							ElseIf vEnd = con.SupplierID Then
								theDiagram.VirtualizeConnector con.ConnectorID, vcTarget, 0, 0
							End If
							theDiagram.Update
						End If
					End If
				End If
				Exit For
			End If
		Next
	Next

End Sub

Sub ReverseConnectorInfo(con)
	Dim startID: startID = con.ClientID
	con.ClientID = con.SupplierID
	con.SupplierID = startID

	Dim startCard: startCard = con.ClientEnd.Cardinality
	con.ClientEnd.Cardinality = con.SupplierEnd.Cardinality
	con.SupplierEnd.Cardinality = startCard

	Dim startRole: startRole = con.ClientEnd.Role
	con.ClientEnd.Role = con.SupplierEnd.Role
	con.SupplierEnd.Role = startRole

	con.ClientEnd.Update
	con.SupplierEnd.Update
	con.Update
End Sub

Sub ChangeElStyle(byref style, setting, value)
    Dim str
    If Len(value) > 0 Then
        str = setting + "=" + value + ";"
    End If
   
    Dim srch
    srch = setting + "="
 
    Dim pos
    pos = InStr(1, style, srch)
    If pos > 0 Then
        Dim endPos, tmp
        endPos = InStr(pos, style, ";")
        tmp = Left(style, pos - 1)
        style = tmp + str + Mid(style, endPos + 1)
    Else
        style = style + str
    End If
End Sub

'Get a specific name/value pair from within a Style string
Function GetOption(styleString, delimiter, optionName)
	Dim index : index = InStr(styleString, optionName)
	Dim s : s = ""
	
	If index > 0 Then
		Dim delimiterIndex : delimiterIndex = InStr(index, styleString, delimiter)
		s = Mid(styleString, index, delimiterIndex - index)
	End If
	GetOption = s
End Function

'Get the value part from a name/value pair (i.e. anything after the equals sign)
Function GetValue(theOption)
	Dim s : s = ""
	Dim index : index = InStr(theOption, "=")
	s = Mid(theOption, index+1)

	GetValue = s
End Function

' Returns zero-based array of values from a select query
Function BuildArrayFromSQL(sql, ColumnName)
    Dim xml, data(), count
    Dim doc, rows, row
	Set doc = CreateObject("MSXML2.DOMDocument")
    xml = Repository.SQLQuery(sql)
	count = 0
	ReDim data(-1)

	If doc.loadXML(xml) Then
        Set rows = doc.selectNodes("//EADATA//Dataset_0//Data//Row")
        For Each row In rows
			Redim Preserve data(count)
			data(count) = row.selectSingleNode(ColumnName).Text
			count = count + 1
        Next
    End If
 BuildArrayFromSQL = data
End Function

' Gets a single field value from the XML result string returned via a call to Repository.SQLQuery
' The parameter field corresponds to the exact field name in EA's database
' Note: Would be safer to use BuildArrayFromSQL to do this instead...
Function ExtractFieldValFromXML(xml, field)

	Dim val, startField, endField
	val = ""
	startField = "<" + field + ">"
	endField = "</" + field + ">"

	Dim fieldLen
	fieldLen = Len(startField)

	If Len(xml) > 0 And fieldLen > 2 Then
		Dim pos1, pos2
		pos1 = Instr(1, xml, startfield)
		pos2 = Instr(1, xml, endField)
		If pos1 > 0 And pos2 > 0 And pos2 > pos1 Then
			val = Mid(xml,pos1+fieldLen,pos2-pos1-fieldLen)
		End If
	End If

	ExtractFieldValFromXML = val

End Function

main