На главную... Продукты | Технологии | Классификаторы | Проекты | Скачать | Цены| Форум | Статьи | Обучение | Контакты

Как рассчитать площадь пересечения двух площадных объектов

Поиск  Пользователи  Правила  Войти
Форум » Настольные приложения » GIS ToolKit, GIS ToolKit Active, ГИС Конструктор для Windows
Страницы: Пред. 1 2 3 4 5
RSS
Как рассчитать площадь пересечения двух площадных объектов, CalcCrossObjectSquare
 
Включите в uses модуль maputil
 
Цитата
Andrey Gheleznyakov написал:
Включите в uses модуль maputil
Добавили, компиляция прошла успешно!

//==========================================================­===================
// Найти объекты пересечений
//==========================================================­===================
procedure TfrmOvl.btnFindCrossObjClick(Sender: TObject);
const
NameFunc = 'cntOverlapTest';
Var
Asinhro : boolean;
res : integer;
NameObject : string;
ExCode : integer;
parm1 : TPROCESSPARM;
hsitenew : HSITE;
hDll  : HMODULE;
pFunc : Dll_cntOverlapTest;
retfunc : integer;
SquareObject : double;
begin
// Здесь должен быть цикл по газонам
frmOvl.MapFind1.Active := false;
frmOvl.MapFind1.FindPoint := false;
frmOvl.MapFind1.MapSelect.Clear;
frmOvl.MapFind1.MapObj.Style := OS_SELECT;
frmOvl.MapFind1.MapSelect.Excode[-1,OL_SQUARE] := false;
frmOvl.MapFind1.MapSelect.Excode[10000040,OL_SQUARE] := true;
frmOvl.MapFind1.Active := true;
frmOvl.MapFind1.First;
frmOvl.MapFind1.Center;

frmOvl.MapFind2.Active := false;
frmOvl.MapFind2.FindPoint := false;
frmOvl.MapFind2.MapSelect.Clear;
frmOvl.MapFind2.MapObj.Style := OS_SELECT;
frmOvl.MapFind2.MapSelect.Excode[-1,OL_SQUARE] := false;
frmOvl.MapFind2.MapSelect.Excode[10000165,OL_SQUARE] := true;
frmOvl.MapFind2.Active := true;
frmOvl.MapFind2.First;
frmOvl.MapFind2.Center;

If Asinhro = false then
ShowMessage ('Найден объект на карте '+
frmOvl.MapFind2.MapObj.ObjName);

SquareObject := 0;

 frmOvl.ovlObj.CreateOVL(1, 0.001, -1, 0); // Здесь все нормально

  If res = 0 then
  begin
  ShowMessage('Ошибка создания объекта оверлейных операций!');
  // exit;
  end;

 res := frmOvl.ovlObj.SetObjectCross(-1, 0.001, 0, ovl_METHOD_SQUARE, ovl_OBJECTINSIDE); // Здесь все нормально, результат 3

  case res of
  1 :
   begin
   If mapGetExclusiveSubject(frmOvl.MapObj1.ObjHandle, 0) = 0 // шаблон не замкнут
   then
   ShowMessage('Все контура объекта совпадают с шаблоном (лежат на шаблоне)!');
   If mapGetExclusiveSubject(frmOvl.MapObj1.ObjHandle, 0) <> 0 // шаблон замкнут
   then
   ShowMessage('Все контура объекта внутри шаблона, либо совпадают!');
   end;
  2 : ShowMessage('Все контура объекта вне шаблона!');
  3 :
  begin
  SquareObject := 0;

  If Asinhro = false then
  ShowMessage('Один или несколько контуров объекта пересекаются с шаблоном!');  // Здесь все нормально

  // создадим временную карту для размещения результата пересечения
  // можно создавать и постоянную
  hsitenew := mapCreateAndAppendTempSite(mvMap.MapHandle, nil);

  ShowMessage ('hsitenew = '+IntToStr(hsitenew));  // Здесь все нормально

  if (hsitenew = 0)
  then begin
    ShowMessage('Временная карта для размещения результата не создана!');
    exit;
  end;

  fillchar(parm1, sizeof(TPROCESSPARM), 0);
  parm1.Map := mvMap.MapHandle;
  parm1.Site2 := hsitenew;

  ShowMessage ('parm1.Map = '+IntToStr(parm1.Map));  // Здесь все нормально
  ShowMessage ('parm1.Site2 = '+IntToStr(parm1.Site2));  // Здесь все нормально

  hDll := 0;
  pFunc := LoadFunction(sGISVECEX, NameFunc, hDll);

  ShowMessage ('hDll = '+IntToStr(hDll));  // Здесь все нормально

  if (hDll = 0)
  then exit;

  // try
  if  (not Assigned (pFunc))
  then
  begin
  ShowMessage ('not Assigned');
  // exit;
  end;

  RetFunc := pFunc(MapObj2.ObjHandle, MapObj1.ObjHandle, 4, @parm1, 0);

  ShowMessage ('RetFunc = '+IntToStr(RetFunc));  // Здесь вернул 0!!!!! Не понятно почему? Не понятно, где здесь объект пересечения, по которому можно определить площадь пересечения? Похоже я не понимаю как работает RetFunc

  if (RetFunc = 0)
  then begin
  ShowMessage('Ошибка при создании пересечений!');
  exit;
  end;

  mvMap.Repaint;

  // finally
  if (hDll <> 0)
  then mapFreeLibrary(hDll);
  // end;

  {
   While 1=1 do
   begin
   frmOvl.MapObj3.CreateObjectByKey(1, KM_IDDOUBLE2, frmOvl.MapObj2.KeyName);

   If frmOvl.ovlObj.GetNextObject = 0 then
   break;

   frmOvl.MapObj3.Commit;
   frmOvl.mvMap.Repaint;
   frmOvl.MapObj3.Style := OS_SELECT;

   If Asinhro = false then
   ShowMessage (frmOvl.MapFind2.MapObj.ObjName+' пересекает зону уборки площадь объекта уборки = '+FloatToStr(frmOvl.MapObj3.Square));

   SquareObject := SquareObject+frmOvl.MapObj3.Square;

   If Asinhro = false then
   ShowMessage (frmOvl.MapFind2.MapObj.ObjName+' нарастающая площадь объекта уборки = '+FloatToStr(SquareObject));

   frmOvl.MapObj3.Delete;
   end;

  frmOvl.ovlObj.FreeOVL;
  NameObject     := frmOvl.MapFind2.MapObj.ObjName;
  ExCode        := frmOvl.MapFind2.MapObj.ExCode;
  }
  frmOvl.ovlObj.FreeOVL;

  If Asinhro = false then
  ShowMessage ('вызываю функцию AppendSanitObjects');

  end;
  4 :
  begin

  SquareObject := frmOvl.MapFind2.MapObj.Square;

  If Asinhro = false then
  begin
  frmOvl.MapFind2.Center;
  ShowMessage('Контур шаблона внутри контура объекта!');
  ShowMessage (frmOvl.MapFind2.MapObj.ObjName+' объект внутри зоны уборки = '+FloatToStr(SquareObject));
  end;

  NameObject     := frmOvl.MapFind2.MapObj.ObjName;
  ExCode        := frmOvl.MapFind2.MapObj.ExCode;

  If Asinhro = false then
  ShowMessage ('вызываю функцию AppendSanitObjects');

  end;
  0 :
   begin
   ShowMessage('Ошибка установки обрабатываемого объекта и метода обработки!');
   exit;
   end;
  end;
 
Возможно вызов ovlObj.SetObjectCross сбивает настройки в MapObj. Никаких ovlObj.SetObjectCross в новой функции вызывать не надо. Цикл для получения частей пересечений тоже организовывать не надо.
Новая функция все пересечения создает на карте, указанной в parm1.Site2, за один вызов. Далее вы организовываете перебор объектов на карте. Один объект - одно пересечение.
Воспользуйтесь приведенным мною тексте вызова функции. Для создания пересечений на указанной карте он самодостаточен.
 
Цитата
Andrey Gheleznyakov написал:
Воспользуйтесь приведенным мною тексте вызова функции. Для создания пересечений на указанной карте он самодостаточен.
procedure TfrmOvl.Button4Click(Sender: TObject);
const
NameFunc = 'cntOverlapTest';
var
parm1 : TPROCESSPARM;
hsitenew : HSITE;
hDll  : HMODULE;
pFunc : Dll_cntOverlapTest;
retfunc : integer;
begin
// Здесь должен быть цикл по газонам
frmOvl.MapFind1.Active := false;
frmOvl.MapFind1.FindPoint := false;
frmOvl.MapFind1.MapSelect.Clear;
frmOvl.MapFind1.MapObj.Style := OS_SELECT;
frmOvl.MapFind1.MapSelect.Excode[-1,OL_SQUARE] := false;
frmOvl.MapFind1.MapSelect.Excode[10000040,OL_SQUARE] := true;
frmOvl.MapFind1.Active := true;
frmOvl.MapFind1.First;
frmOvl.MapFind1.Center;

ShowMessage ('найден газон на карте');

// Здесь должен быть цикл по зонам уборки муниципальной

frmOvl.MapFind2.Active := false;
frmOvl.MapFind2.FindPoint := false;
frmOvl.MapFind2.MapSelect.Clear;
frmOvl.MapFind2.MapObj.Style := OS_SELECT;
frmOvl.MapFind2.MapSelect.Excode[-1,OL_SQUARE] := false;
frmOvl.MapFind2.MapSelect.Excode[10000165,OL_SQUARE] := true;
frmOvl.MapFind2.Active := true;
frmOvl.MapFind2.First;
frmOvl.MapFind2.Center;

// ShowMessage ('найдена зона уборки на карте');

// If Asinhro = false then
ShowMessage ('Найден объект на карте '+
frmOvl.MapFind2.MapObj.ObjName);

// создадим временную карту для размещения результата пересечения
// можно создавать и постоянную
hsitenew := mapCreateAndAppendTempSite(mvMap.MapHandle, nil);
if (hsitenew = 0)
  then begin
    ShowMessage('Временная карта для размещения результата не создана!');
    exit;
  end;

fillchar(parm1, sizeof(TPROCESSPARM), 0);
parm1.Map := mvMap.MapHandle;
parm1.Site2 := hsitenew;

hDll := 0;
pFunc := LoadFunction(sGISVECEX, NameFunc, hDll);

ShowMessage ('hDll = '+IntToStr(hDll)); // Здесь возвращается число

if (hDll = 0)
 then exit;

try
 if  (not Assigned (pFunc))
   then exit;

 RetFunc := pFunc(MapObj2.ObjHandle, MapObj1.ObjHandle, 4, @parm1, 0);

 ShowMessage ('RetFunc = '+IntToStr(RetFunc)); // Здесь возвращается 0. Так же не должно быть?

 if (RetFunc = 0)
  then begin
    ShowMessage('Ошибка при создании пересечений!');
    exit;
  end;

 mvMap.Repaint;

finally
 if (hDll <> 0)
   then mapFreeLibrary(hDll);
end;
end;
 
Свой пример и тексты компонентов выслал на почту.
 
MapFind1.MapObj и MapFind2.MapObj - это разные компоненты?
Страницы: Пред. 1 2 3 4 5
Читают тему (гостей: 1)



© КБ Панорама, 1991-2024

Регистрируясь или авторизуясь на форуме, Вы соглашаетесь с Политикой конфиденциальности