upathfinder.pas

路径查找代码[dephi版本代码]

unit uPathFinder;

interface

uses
  Windows, classes, ActiveX, ComObj, NetObjD4_TLB,
  esriCore_TLB;

type
  TPathFinder = class(TTypedComObject, IPathFinder)
  private
    m_ipGeometricNetwork:     IGeometricNetwork;
    m_ipMap:                  IMap;
    m_ipPoints:               IPointCollection;
    m_ipPointToEID:           IPointToEID;
    // reults
    m_dblPathCost:            Double;
    m_ipEnumNetEID_Junctions: IEnumNetEID;
    m_ipEnumNetEID_Edges:     IEnumNetEID;
    m_ipPolyline:             IPolyLine;
    procedure CloseWorkspace;
    function  InitializeNetworkAndMap(const FeatureDataset: IFeatureDataset): Boolean;
  protected
    // IPathFinder
    function OpenAccessNetwork(const AccessFileName, FeatureDatasetName: WideString): HResult; stdcall;
    function OpenFeatureDatasetNetwork(const FeatuteDataset: IFeatureDataset): HResult; stdcall;
    function Get_StopPoints(out Points: IPointCollection): HResult; stdcall;
    function Set_StopPoints(const Points: IPointCollection): HResult; stdcall;
    function Get_PathCost(out Value: Double): HResult; stdcall;
    function SolvePath(const WeightName: WideString): HResult; stdcall;
    function Get_PathPolyLine(out Line: IPolyline): HResult; stdcall;
    function Get_Map(out Map: IMap): HResult; stdcall;
    function Set_Map(const Map: IMap): HResult; stdcall;
  public
    destructor Destroy; override;
  end;

implementation

uses ComServ, sysutils,
     dialogs;                 // for ShowMessage()

function TPathFinder.OpenAccessNetwork(const AccessFileName,
  FeatureDatasetName: WideString): HResult;
var
  ipWorkspaceFactory:       IWorkspaceFactory;
  ipWorkspace:              IWorkspace;
  ipFeatureWorkspace:       IFeatureWorkspace;
  ipFeatureDataset:         IFeatureDataset;
begin
  // After this function exits, we'll have an INetwork interface
  // and an IMap interface initialized for the network we'll be using.

  // close down the last one if opened
  CloseWorkspace;

  try
    // open the mdb
    ipWorkspaceFactory := CoAccessWorkspaceFactory.Create as IWorkspaceFactory;
    OleCheck( ipWorkspaceFactory.OpenFromFile(AccessFileName, 0, ipWorkspace) );

    // Note: The Delphi OleCheck() function just does if res <> S_OK then raise error
    //       You would want your COM object to support ISupportErrorInfo, etc for better error
    //       reporting from within this object.

    // get the FeatureWorkspace
    ipFeatureWorkspace := ipWorkspace as IFeatureWorkspace;

    // open the FeatureDataset
    OleCheck( ipFeatureWorkspace.OpenFeatureDataset(FeatureDatasetName, ipFeatureDataset) );

    // initialize Network and Map (m_ipNetwork, m_ipMap)
    if not InitializeNetworkAndMap(ipFeatureDataset) then Exception.Create('Error initializing Network and Map');

  except
    OpenAccessNetwork := E_FAIL;
  end;

  OpenAccessNetwork := S_OK;
end;

function TPathFinder.OpenFeatureDatasetNetwork(
  const FeatuteDataset: IFeatureDataset): HResult;
begin
  // close down the last one if opened
  CloseWorkspace;

  try
    // we assume that the caller has passed a valid, opened FeatureDataset

    // initialize Network and Map (m_ipNetwork, m_ipMap)
    if not InitializeNetworkAndMap(FeatuteDataset) then Exception.Create('Error initializing Network and Map');

  except
    OpenFeatureDatasetNetwork := E_FAIL;
  end;

  OpenFeatureDatasetNetwork := S_OK;
end;

function TPathFinder.InitializeNetworkAndMap(const FeatureDataset: IFeatureDataset): Boolean;
var
  ipNetworkCollection:      INetworkCollection;
  ipNetwork:                INetwork;
  count, i:                 Integer;
  ipFeatureClassContainer:  IFeatureClassContainer;
  ipFeatureClass:           IFeatureClass;
  ipGeoDataset:             IGeoDataset;
  ipLayer:                  ILayer;
  ipFeatureLayer:           IFeatureLayer;
  ipEnvelope,ipMaxEnvelope: IEnvelope;
  dblSearchTol:             Double;
  dblWidth, dblHeight:      Double;
begin
  try
    // get the networks
    ipNetworkCollection := FeatureDataset as INetworkCollection;

    // even though a FeatureDataset can have many networks, we'll just
    // assume the first one (otherwise you would pass the network name in, etc.)

    // get the count of networks
    OleCheck( ipNetworkCollection.Get_GeometricNetworkCount(count) );

    if count = 0 then Exception.Create('No networks found');

    // get the first Geometric Newtork (0 - based)
    OleCheck( ipNetworkCollection.Get_GeometricNetwork(0, m_ipGeometricNetwork) );

    // get the Network
    OleCheck( m_ipGeometricNetwork.Get_Network(ipNetwork));

    // The EID Helper class that converts points to EIDs needs a
    // IMap, so we'll need one around with all our layers added.
    // This Pathfinder object has an optional Map property than may be set
    // before opening the Network.
    if m_ipMap = nil then begin
      m_ipMap := CoMap.Create as IMap;

      // Add each of the Feature Classes in this Geometric Network as a map Layer
      ipFeatureClassContainer := m_ipGeometricNetwork as IFeatureClassContainer;
      OleCheck( ipFeatureClassContainer.Get_ClassCount(count) );
      if count = 0 then Exception.Create('No (network) feature classes found');

      for i := 0 to count - 1 do
        begin
          // get the feature class
          OleCheck( ipFeatureClassContainer.Get_Class_(i, ipFeatureClass) );
          // make a layer
          ipFeatureLayer := CoFeatureLayer.Create as IFeatureLayer;
          OleCheck( ipFeatureLayer.Set_FeatureClass(ipFeatureClass) );
          // add layer to the map
          OleCheck( m_ipMap.AddLayer(ipFeatureLayer as ILayer) );
        end;
    end;     // if we needed to make a Map


    // Calculate point snap tolerance as 1/100 of map width.
    OleCheck( m_ipmap.Get_LayerCount(count) );
    ipMaxEnvelope := CoEnvelope.Create as IEnvelope;
    for i := 0 to count - 1 do
      begin
        OleCheck( m_ipMap.Get_Layer(i, ipLayer) );
        ipFeatureLayer := ipLayer as IFeatureLayer;
        // get its dimensions (for setting search tolerance)
        ipGeoDataset := ipFeatureLayer as IGeoDataset;
        OleCheck( ipGeoDataset.Get_Extent(ipEnvelope) );
        // merge with max dimensions
        OleCheck( ipMaxEnvelope.Union(ipEnvelope) );
      end;

    // finally, we can set up the IPointToEID ...
    m_ipPointToEID := CoPointToEID.Create as IPointToEID;
    OleCheck( m_ipPointToEID.Set_SourceMap(m_ipMap) );
    OleCheck( m_ipPointToEID.Set_GeometricNetwork(m_ipGeometricNetwork) );

    // set snap tolerance
    OleCheck( ipMaxEnvelope.Get_Width(dblWidth) );
    OleCheck( ipMaxEnvelope.Get_Height(dblHeight) );

    if dblWidth > dblHeight then
      dblSearchTol := dblWidth / 100
    else
      dblSearchTol := dblHeight / 100;

    OleCheck( m_ipPointToEID.Set_SnapTolerance(dblSearchTol) );

    InitializeNetworkAndMap := True;     // good to go
  except
    InitializeNetworkAndMap := False;    // we had an error
  end;
end;

function TPathFinder.Get_StopPoints(out Points: IPointCollection): HResult;
begin
  Get_StopPoints := S_OK;
  try
    Points := m_ipPoints;
  except
    Get_StopPoints := E_FAIL;
  end;
end;

function TPathFinder.Set_StopPoints(
  const Points: IPointCollection): HResult;
begin
  Set_StopPoints := S_OK;
  try
    m_ipPoints := Points;
  except
    Set_StopPoints := E_FAIL;
  end;
end;

function TPathFinder.SolvePath(const WeightName: WideString): HResult;
var
  ipNetwork:          INetwork;
  ipTraceFlowSolver:  ITraceFlowSolver;
  ipNetSolver:        INetSolver;
  ipNetFlag:          INetFlag;
  ipaNetFlag:         array of IEdgeFlag;
  ipEdgePoint:        IPoint;
  ipNetElements:      INetElements;
  intEdgeUserClassID: Integer;
  intEdgeUserID:      Integer;
  intEdgeUserSubID:   Integer;
  intEdgeID:          Integer;
  ipFoundEdgePoint:   IPoint;
  dblEdgePercent:     Double;
  ipNetWeight:        INetWeight;
  ipNetSolverWeights: INetSolverWeights;
  ipNetSchema:        INetSchema;
  intCount:           Integer;
  i:                  Integer;
  vaRes:              array of OleVariant;
begin

  try
    // make sure we are ready
    Assert(m_ipPoints <> nil, 'StopPoints are set');
    Assert(m_ipGeometricNetwork <> nil, 'Network is set');

    // instantiate a trace flow solver
    ipTraceFlowSolver := CoTraceFlowSolver.Create as ITraceFlowSolver;

    // get the INetSolver interface
    ipNetSolver := ipTraceFlowSolver as INetSolver;

    // set the source network to solve on
    OleCheck( m_ipGeometricNetwork.Get_Network(ipNetwork) );
    OleCheck( ipNetSolver.Set_SourceNetwork(ipNetwork) );

    // make edge flags from the points

    // the INetElements interface is needed to get UserID, UserClassID,
    // and UserSubID from an element id (EID)
    ipNetElements := ipNetwork as INetElements;

    // get the count
    OleCheck( m_ipPoints.Get_PointCount(intCount) );
    Assert(intCount > 1, '2 or more points are needed');

    // dimension our IEdgeFlag array
    SetLength(ipaNetFlag, intCount);
    for i := 0 To intCount - 1 do
      begin
        // make a new Edge Flag
        ipNetFlag := CoEdgeFlag.Create as INetFlag;
        OleCheck( m_ipPoints.Get_Point(i, ipEdgePoint) );
        // look up the EID for the current point  (this will populate intEdgeID and dblEdgePercent)
        OleCheck( m_ipPointToEID.GetNearestEdge(ipEdgePoint, intEdgeID, ipFoundEdgePoint, dblEdgePercent) );
        Assert (intEdgeID > 0, 'Point (eid) not found');
        OleCheck( ipNetElements.QueryIDs(intEdgeID, esriETEdge, intEdgeUserClassID, intEdgeUserID, intEdgeUserSubID) );
        Assert((intEdgeUserClassID > 0) and (intEdgeUserID > 0), 'Point not found');
        OleCheck( ipNetFlag.Set_UserClassID(intEdgeUserClassID) );
        OleCheck( ipNetFlag.Set_UserID(intEdgeUserID) );
        OleCheck( ipNetFlag.Set_UserSubID(intEdgeUserSubID) );
        ipaNetFlag[i] := ipNetFlag as IEdgeFlag;
      end;

    // add these edge flags
    OleCheck( ipTraceFlowSolver.PutEdgeOrigins(intCount,ipaNetFlag[0]) );

    // set the weight (cost field) to solve on

    // get the INetSchema interface
    ipNetSchema := ipNetwork as INetSchema;
    OleCheck( ipNetSchema.Get_WeightByName(WeightName, ipNetWeight) );
    Assert(ipNetweight <> nil, 'Weight: ' + WeightName + ' not found');

    // set the weight (use the same for both directions)
    // Note: You could set Junction weights here as well.
    ipNetSolverWeights := ipTraceFlowSolver as INetSolverWeights;
    OleCheck( ipNetSolverWeights.Set_FromToEdgeWeight(ipNetweight) );
    OleCheck( ipNetSolverWeights.Set_ToFromEdgeWeight(ipNetweight) );

    // initialize array for results to number of segments in result
    SetLength(vaRes, intCount - 1);

    // solve it
    OleCheck( ipTraceFlowSolver.FindPath(esriFMConnected, esriSPObjFnMinSum, m_ipEnumNetEID_Junctions, m_ipEnumNetEID_Edges, intCount - 1, vaRes[0]) );

    // compute total cost
    m_dblPathCost := 0;
    for i := Low(vaRes) to High(vaRes) do
      m_dblPathCost := m_dblPathCost + vaRes[i];

    // clear the last polyline result
    m_ipPolyline := nil;

    SolvePath := S_OK;        // good to go
  except
    SolvePath := E_FAIL;      // had an error
  end;
end;

function TPathFinder.Get_PathCost(out Value: Double): HResult;
begin
  Value := m_dblPathCost;
  Get_PathCost := S_OK;
end;

// Close the mdb and network objects
procedure TPathFinder.CloseWorkspace;
begin
  // additional precautions to make sure we let go of everything and start
  // with new results
  m_ipGeometricNetwork := nil;
  m_ipPoints := nil;
  m_ipPointToEID := nil;
  m_ipEnumNetEID_Junctions := nil;
  m_ipEnumNetEID_Edges := nil;
  m_ipPolyline := nil;
end;

destructor TPathFinder.Destroy;
begin
  // close the map
  m_ipMap := nil;
  // close down the workspace
  CloseWorkspace;
  inherited Destroy;
end;

//  Get_PathPolyLine returns a Polyline from the calculated path
//

function TPathFinder.Get_PathPolyLine(out Line: IPolyline): HResult;
var
  ipEIDHelper:           IEIDHelper;
  count, i:              Integer;
  ipEIDInfo:             IEIDInfo;
  ipEnumEIDInfo:         IEnumEIDInfo;
  ipGeometry:            IGeometry;
  ipNewGeometryColl:     IGeometryCollection;
  ipSpatialReference:    ISpatialReference;
begin

  Get_PathPolyLine := S_OK;

  // if the line is already computed since the last path, just return it
  if m_ipPolyline <> nil then
    begin
      Line := m_ipPolyline;
      Exit;
    end;

  m_ipPolyline := CoPolyLine.Create as IPolyLine;
  ipNewGeometryColl := m_ipPolyline as IGeometryCollection;

  // a path should be solved first
  Assert(m_ipEnumNetEID_Edges <> nil, 'No results computed yet.');

  try
    // make an EIDHelper object to translate edges to geometric features
    ipEIDHelper := CoEIDHelper.Create as IEIDHelper;
    OleCheck( ipEIDHelper.Set_GeometricNetwork(m_ipGeometricNetwork) );
    OleCheck( m_ipMap.Get_SpatialReference(ipSpatialReference) );
    OleCheck( ipEIDHelper.Set_OutputSpatialReference(ipSpatialReference) );
    OleCheck( ipEIDHelper.Set_ReturnGeometries(True) );

    // get the details using the  IEIDHelper classes
    OleCheck( ipEIDHelper.CreateEnumEIDInfo(m_ipEnumNetEID_Edges, ipEnumEIDInfo) );
    OleCheck( ipEnumEIDInfo.Get_Count(count) );

    // set the iterator to beginning
    OleCheck( ipEnumEIDInfo.Reset );

    for i := 1 to count do
      begin
        // get the next EID and a copy of its geometry (it makes a Clone)
        OleCheck( ipEnumEIDInfo.Next(ipEIDInfo) );
        OleCheck( ipEIDInfo.Get_Geometry(ipGeometry) );

        OleCheck( ipNewGeometryColl.AddGeometryCollection(ipGeometry as IGeometryCollection) );

        // Note: Before using AddGeometryCollection() above, AddGeometry() was in
        //       this loop and the only way to get the optional argument to
        //       work (and get ignored) was to do:
        //
        // ovBefore, ovAfter:    OleVariant;
        // TVarData(ovBefore).VType := varError;
        // TVarData(ovAfter).VType := varError;
        // OleCheck( ipGeometryCollection.AddGeometry(ipNewGeometry, ovBefore, ovAfter) );

      end;  // next EID

    // return the merged geometry as a Polyline
    Line := m_ipPolyline;

  except
    Line := nil;
    Get_PathPolyLine := E_FAIL;
  end;
end;

function TPathFinder.Get_Map(out Map: IMap): HResult;
begin
  Get_Map := S_OK;
  try
    Map := m_ipMap;
  except
    Get_Map := E_FAIL;
  end;
end;

function TPathFinder.Set_Map(const Map: IMap): HResult;
begin
  Set_Map := S_OK;
  try
    // clear any existing Map
    if m_ipMap <> nil then
      begin
        OleCheck( m_ipMap.ClearLayers );
        m_ipMap := nil;
      end;
    m_ipMap := Map;
  except
    Set_Map := E_FAIL;
  end;
end;

initialization
  TTypedComObjectFactory.Create(ComServer, TPathFinder, Class_PathFinder,
    ciMultiInstance, tmApartment);
end.