トポロジの構築

Public Sub CreateTopology()

Dim pWSFact As IWorkspaceFactory
Set pWSFact = New AccessWorkspaceFactory

Dim pWor As IWorkspace
Set pWor = pWSFact.OpenFromFile("D:\WorkSpace\Personal Geodatabase.mdb", 0)

Dim pFWS As IFeatureWorkspace
Set pFWS = pWor

Dim pDS As IDataset
Set pDS = pFWS.OpenFeatureDataset("Dataset")

Dim pTopoCont As ITopologyContainer
Set pTopoCont = pDS

'Create the topology
Dim pTopo As ITopology
Set pTopo = pTopoCont.CreateTopology("Topology", pTopoCont.DefaultClusterTolerance, -1, "")

Dim pFCC As IFeatureClassContainer
Set pFCC = pDS

Dim pFC As IFeatureClass
Set pFC = pFCC.ClassByName("Roads")

'Add the feature class to the topology
pTopo.AddClass pFC, 5, 1, 1, False

'Create the first rule
Dim pRule As ITopologyRule
Dim pRuleCont As ITopologyRuleContainer
Set pRule = New TopologyRule
pRule.TopologyRuleType = esriTRTLineNoOverlap
pRule.OriginClassID = pFC.ObjectClassID
pRule.AllOriginSubtypes = True
pRule.Name = "Roads No Overlap"

'Add the rule to the topology
Set pRuleCont = pTopo
pRuleCont.AddRule pRule

'Create the second rule
Set pRule = New TopologyRule
pRule.TopologyRuleType = esriTRTLineNoDangles
pRule.OriginClassID = pFC.ObjectClassID
pRule.AllOriginSubtypes = True
pRule.Name = "Roads No Dangles"

'Add the rule to the topology
If pRuleCont.CanAddRule(pRule) Then pRuleCont.AddRule pRule

End Sub