'********************************************************************* '******************************************************************** 'Philippe Apparicio '2 juillet 1999 'CLOSEST FACILITIES 'Sélection d'un Thème NETWORK 'Sélection de 2 thèmes points : 'point ORIGINE (ex : BATIMENTS HLM) 'point DESTINATION (ex : EPICERIES) 'Nom du thème de sortie (ex: TRAJET LE PLUS COURT HLM EPICERIES) 'Dans le thème de sortie : ' - Objet polyligne : le trajet ' - Champ Origine : Nom du bâtiment HLM ' - Champ DESTINATION : Nom de l'épicerie 'Andy Long 'English version '8/28/2002 'Select a network theme (which should be the active theme in the view) 'Select two point themes: ' point theme of origins ' point theme of destinations 'A file name of the output theme will be required. That file will contain 'fields ' 1. polyline trajectories from origin points to destination points ' along the network. ' 2. a field of the origin point names ' 3. a field of the destination point names '******************************************************************** '******************************************************************** 'Vue active ? '''''''''''''''''''''''''''''''''''''' aView = av.GetActiveDoc if (not (aView.Is(View))) then ' msgBox.Error("Le document actif n'est pas une vue.","") msgBox.Error("The active document isn't a view.","") exit end 'Existe-t-il une couche RESEAU DE RUE ? '''''''''''''''''''''''''''''''''''''''' aNetFTab = nil for each t in aView.GetThemes ft = t.GetFTab if (NetDef.CanMakeFromFTab(ft)) then aNetFtab = ft break end end if (aNetFTab = nil) then ' msgBox.Error("Le Thème NetWork n'est pas ouvert dans la vue"++aView.asstring+".","") msgBox.Error("A network theme is not open in the view"++aView.asstring+".","") exit end ' make the NetDef and check it for error aNetDef = NetDef.Make(aNetFTab) if (aNetDef.HasError) then msgBox.Error("NetDef has error.","") exit end ' make the Network object aNetwork = Network.Make(aNetDef) 'Thèmes points '''''''''''''''''''''''''''''''''''''''''' aPointThemeList = {} for each t in aView.GetThemes if (t.GetFTab.GetSrcName.GetSubName = "Point") then aPointThemeList.Add(t) end end if (aPointThemeList.Count = 0) then ' msgBox.Error("Aucun thème point n'est ouvert dans la vue"++aView.asstring+".","") msgBox.Error("No point theme is open in the view"++aView.asstring+".","") exit end 'Boîte de dialogue du Thème point ORIGINE ''''''''''''''''''''''''''''''''''''''''''' origTheme = msgBox.Choice(aPointThemeList, ' "Sélection du thème point ORIGINE :", ' "ORIGINE (vue"++aView.asstring+")") "Origin point theme:", "ORIGIN (view"++aView.asstring+")") If (origTheme = nil) Then Exit End 'Boîte de dialogue du Thème point DESTINATION '''''''''''''''''''''''''''''''''''''''''''''' destTheme = msgBox.Choice(aPointThemeList, ' "Sélection du thème point DESTINATION:", ' "DESTINATION (vue"++aView.asstring+")") "Destination point theme:", "DESTINATION (view"++aView.asstring+")") If (destTheme= nil) Then Exit End 'Création du THEME DE SORTIE '''''''''''''''''''''''''''''''''''''''''''' 'myfile=FileDialog.Put("TRAJET".AsfileName,"*.shp","Nom du thème de sortie") myfile=FileDialog.Put("TRAJET".AsfileName,"*.shp","Output file name") If (myfile= nil) Then Exit End myFtab = Ftab.MakeNew(myfile,polyLine) f1=Field.Make("Origin",#FIELD_CHAR,150,0) f2=Field.Make("Destination",#FIELD_CHAR,150,0) f3=Field.Make("DISTANCE",#FIELD_DECIMAL,10,3) myFtab.AddFields({f1,f2,f3}) ShapeF=myFtab.FindField("shape") 'Le thème myTheme= FTheme.Make(myFtab) aView.AddTheme(myTheme) MyTheme.SetVisible(true) myTheme.SetActive(true) 'Initialisation des variables ''''''''''''''''''''''''''''''''''''''''''''' origFTab = origTheme.GetFTab destFTab = destTheme.GetFTab origShapeField = origFTab.FindField("Shape") destShapeField = destFTab.FindField("Shape") origLabelField = origTheme.GetLabelField destLabelField = destTheme.GetLabelField 'Liste des points ORIGINE et DESTINATION et nom des points ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' origPointList = {} for each rec in origFTab p = origFTab.ReturnValue(origShapeField, rec) if (aNetwork.IsPointOnNetwork(p)) then if (origLabelField <> nil) then p.SetName(origFTab.ReturnValueString(origLabelField, rec)) else p.SetName("Origin" + (origPointList.Count + 1).AsString) end origPointList.Add(p) end end destPointList = {} for each rec in destFTab p = destFTab.ReturnValue(destShapeField, rec) if (aNetwork.IsPointOnNetwork(p)) then if (origLabelField <> nil) then p.SetName(destFTab.ReturnValueString(destLabelField, rec)) else p.SetName("Destination" + (destPointList.Count + 1).AsString) end destPointList.Add(p) end end 'PARAMETRES DU FindClosestFac ''''''''''''''''''''''''''' numToFind = destPointList.Count ' find all destinations cuttOff = 0 ' no cut off distance toFrom = True ' travel to destination aCostList = aNetDef.GetCostFields if (aCostList.Count > 1) then aCost = msgBox.Choice(aCostList, "Select a cost for the problem:", "Cost selection") else aCost = aCostList.Get(0) end ' Set the cost for the problem. aNetwork.SetCostField(aCost) 'Ecriture dans le THEME DE SORTIE ''''''''''''''''''''''''''''''''''''' iPointList = {} iPointNumber = 0 for each i in 1..origPointList.Count iPoint = origPointList.Get(iPointNumber) iPointList.Add(iPoint) aNumFindList = aNetwork.FindClosestFac(iPointList, destPointList, numToFind, cuttOff, toFrom) 'FindClosestFac a-t-il fonctionnée ? if (not (aNetwork.HasClosestFacResult)) then ' msgBox.Error("Solution non trouvée.","") msgBox.Error("Solution not found.","") exit end 'Get the index into the original destination list for the Closest facility. FOR each ii in 0..(iPointList.Count - 1) for each j in 1..aNumFindList.Get(ii) destNum = aNetwork.GetClosestFacIndex(ii,j) solCostStr = aNetwork.GetClosestFacPathCost(ii,j).asString 'Création de la polyligne ApathShape = aNetwork.ReturnClosestFacShape(ii,j) 'Ecriture des attributs et des objets dans le thème de sortie rec = MyFtab.AddRecord MyFtab.SetValue(ShapeF,rec,ApathShape) MyFtab.SetValue(f1,rec,origPointList.Get(iPointNumber).GetName) MyFtab.SetValue(f2,rec,destPointList.Get(destNum).GetName) MyFtab.SetValue(f3,rec,solCostStr) end END aNetwork.ClearClosestFacResult iPointList.Empty aNumFindList.Empty iPointNumber = iPointNumber + 1 end