'********************************************************************* '******************************************************************** '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 '******************************************************************** '******************************************************************** 'Vue active ? '''''''''''''''''''''''''''''''''''''' aView = av.GetActiveDoc if (not (aView.Is(View))) then msgBox.Error("Le document actif n'est pas une vue.","") 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+".","") 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+".","") 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+")") 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+")") If (destTheme= nil) Then Exit End 'Création du THEME DE SORTIE '''''''''''''''''''''''''''''''''''''''''''' myfile=FileDialog.Put("TRAJET".AsfileName,"*.shp","Nom du thème de sortie") If (myfile= nil) Then Exit End myFtab = Ftab.MakeNew(myfile,polyLine) f1=Field.Make("Origine",#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.","") 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