トポロジの構築

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