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

CreateOVL

Поиск  Пользователи  Правила  Войти
Форум » Настольные приложения » GIS ToolKit, GIS ToolKit Active, ГИС Конструктор для Windows
Страницы: 1 2 След.
RSS
CreateOVL, Как вычислить общую площадь двух пересекаемых площадных объекта
 
Здравствуйте!

В примерах ГТК есть проект mapOverlay.
Но что-то я зациклился и не могу понять, где я не правильно написал исходный код:

procedure Tform_main.BitBtn1Click(Sender: TObject);
Var
i : integer;
q : double;
begin
// Шаблон
form_main.MapFind1.Active := false;
form_main.MapFind1.FindPoint := false;
form_main.MapFind1.MapSelect.Clear;
form_main.MapFind1.MapSelect.Excode[-1,0] := false;
form_main.MapFind1.MapSelect.Excode[10000017,OL_SQUARE] := true;
form_main.MapFind1.Active := true;
form_main.MapFind1.First;
form_main.MapFind1.Center;
Temp.StyleSelect := SEL_LINE;
Temp.Style := OS_SELECT;
Temp.Center;
ShowMessage ('найден Шаблон');

// Пересекаемый объект
form_main.MapFind2.Active := false;
form_main.MapFind2.FindPoint := false;
form_main.MapFind2.MapSelect.Clear;
form_main.MapFind2.MapSelect.Excode[-1,0] := false;
form_main.MapFind2.MapSelect.Excode[10000019,OL_SQUARE] := true;
form_main.MapFind2.Active := true;
form_main.MapFind2.First;
form_main.MapFind2.Center;
objIn.StyleSelect := SEL_LINE;
objIn.Style := OS_SELECT;
objIn.Center;
ShowMessage ('найден пересекаемый объект');
ovlObj.CreateOVL(0,0.001,0, 1);
ovlObj.SetObjectCross(0, 0.001, 0, ovl_METHOD_SQUARE, ovl_ANYOBJECT);
ShowMessage ('objIn.KeyName = '+objIn.KeyName);
objOut.CreateObjectByKey(1, KM_IDDOUBLE2, objIn.KeyName);
objOut.Commit;
i := objOut.ObjHandle;
ShowMessage ('i = '+IntToStr(i)); // здесь выдает номер нормально
q := objOut.Square;
ShowMessage ('q = '+FloatToStr(q)); // Площадь равна 0
Temp.Style := OS_NORMAL;
objIn.Style := OS_NORMAL;
objOut.StyleSelect := SEL_LINE;
objOut.Style := OS_SELECT;
mvMap.Repaint;
end;

Очень похоже на то, что objOut не получил координаты, по которым он должен быть создан.
Просьба подсказать, что я не правильно делаю?
screenshort1.PNG (61.03 КБ)
 
Возможно решение задачи на MapAPI:

procedure Tform_main.BitBtn2Click(Sender: TObject);
Var
ResultObject: integer;
Cr: HOVL;
begin
form_main.MapFind1.Active := false;
form_main.MapFind1.FindPoint := false;
form_main.MapFind1.MapSelect.Clear;
form_main.MapFind1.MapSelect.Excode[-1,0] := false;
form_main.MapFind1.MapSelect.Excode[10000017,OL_SQUARE] := true;
form_main.MapFind1.Active := true;
form_main.MapFind1.First;
form_main.MapFind1.Center;
Temp.StyleSelect := SEL_LINE;
Temp.Style := OS_SELECT;
Temp.Center;
form_main.MapFind2.Active := false;
form_main.MapFind2.FindPoint := false;
form_main.MapFind2.MapSelect.Clear;
form_main.MapFind2.MapSelect.Excode[-1,0] := false;
form_main.MapFind2.MapSelect.Excode[10000019,OL_SQUARE] := true;
form_main.MapFind2.Active := true;
form_main.MapFind2.First;
form_main.MapFind2.Center;
objIn.StyleSelect := SEL_LINE;
objIn.Style := OS_SELECT;
objIn.Center;
Cr:=ovlCreate(form_main.mvMap.MapHandle,1,0.0);
ovlSetTemplet(Cr, form_main.MapFind1.MapObj.ObjHandle, 0, 1);
ResultObject := mapCreateObject(form_main.mvMap.MapHandle,1,KM_IDDOUBLE2,1);
ovlSetObjectCross(Cr, form_main.MapFind2.MapObj.ObjHandle, -1, 0.0, 0, ovl_METHOD_SQUARE, ovl_ANYOBJECT or ovl_OBJECTOVERLAP);
mapRegisterObject(ResultObject,mapObjectExcode(form_main.MapFind2.MapObj.ObjHandle),OL_SQUARE);
mapCommitObjectAsNew(ResultObject);
mapFreeObject(ResultObject);
ovlFree(Cr);
end;

Но в результате все равно не создается объект пересечения двух площадных объектов.
Что-то опять я не правильно делаю?
Изменено: Сергей Викторович - 20.02.2017 15:11:46
 
Цитата
Сергей Викторович написал:
Но в результате все равно не создается объект пересечения двух площадных объектов.
Что-то опять я не правильно делаю?
Во первых , при пересечении двух площадных объектов не создаются никакие объекты .
Результат такого пересечения - вырезка с базового объекта, объектом "резаком"
Во вторых, если Вы хотите достичь эффекта вырезания части объекта с базового при условии что оба объекта площадные, Вам необходимо выполнить следующие операции
1. создать линейный объект резак по координатам площадного аналога
2. выполнить разрезки базового объекта
3. сохранить результат вырезки
4. удалить временный объект резак
ИЛИ
воспользоваться другим методом разрезки объектов (см. ниже)

Пример:
Код
// функция поиска пересечений. Возвращает площадь пересечения
function TMainForm.CalcCrossObject(ExtMap : HMap; baseObj, crossObj : HObj): double;
var cross   : HCross;
    obj     : HObj;
begin
  cross  := mapCreateObjectsCross(baseObj, crossObj, OL_SQUARE, 0.001);
  result := 0;
  if Cross=0 then exit;
  obj   := mapCreateSiteObject(ExtMap, ExtMap, KM_IDFLOAT3, 0);
  while mapGetNextCross(cross, obj)<>0 do
     result := result+mapSquareInMap(obj);
  mapFreeObjectsCross(cross);
  mapFreeObject(obj);
end;

где obj - результат пересечения вне зависимости от локализации
по крайней мере так написано в описании функции
Код
//********************************************************************
 //*     ФУНКЦИИ ПЕРЕСЕЧЕНИЯ ОБ'ЕКТОВ ЭЛЕКТРОННОЙ КАРТЫ               *
 //*                                                                  *
 //* Пересечение двух объектов; т.е. нахождение общей части объектов; *
 //* один из которых (ПЕРВЫЙ объект карты) - РЕЗАК(по которому режут) *
 //* другой (ВТОРОЙ объект карты) - ОБЪЕКТ; КОТОРЫЙ РЕЖУТ.            *
 //* Только для ПЛОЩАДНЫХ или ЛИНЕЙНЫХ объектов !!!                   *
 //********************************************************************

 // *********************************************************
 //
 // Схема запуска:
 // =============
 // Cross : HCross = mapCreateObjectsCross(info1;info2;method;precision)
 // if (hCross)
 //    {
 //    while(mapGetNextCross(hCross;info))
 //         {
 //         ...
 //         }
 //    mapFreeObjectsCross(hCross);
 //    }
 //**********************************************************

 // Пересечение двух объектов; т.е. нахождение общей части объектов;
 // один из которых (ПЕРВЫЙ объект карты) - РЕЗАК(по которому режут)
 // другой (ВТОРОЙ объект карты) - ОБЪЕКТ; КОТОРЫЙ РЕЖУТ.
 //
 // Создание класса пересечения
 // Только для ПЛОЩАДНЫХ или ЛИНЕЙНЫХ объектов !!!
 // info1 - первый объект карты - РЕЗАК (произвольный замкнутый контур; подобъекты не учитываются)
 // info2 - второй объект карты (площадной объект с подобъектами)
 // или
 // info1 - первый объект карты - РЕЗАК (произвольный замкнутый контур с подобъектами)
 // info2 - второй объект карты (линейный объект с подобъектами)      // 09/08/04
 // Пересечение произвольных площадных объектов с подобъектами - mapCreateObjectsCrossSquare(...)
 // method - тип результирующих объектов
 //          LOCAL_SQUARE - площадной; LOCAL_LINE - линейный
 //          тип результирующих объектов зависит от типа
 //          второго объекта:
 //          - если второй объект незамкнутый; то тип только LOCAL_LINE;
 //          - если второй объект замкнутый; то тип может быть LOCAL_LINE или LOCAL_SQUARE.
 // При логическом сложении method и флага проверки входимости (FLAGINSIDEOBJECTS = 32
 // см. maptype.h) в класс пересечения будут добавлены объекты; которые полностью входят
 // в объект - РЕЗАК  (напр. LOCAL_SQUARE | FLAGINSIDEOBJECTS)     //24/08/04
 // precision - точность при дотягивании (в метрах); при precision=0 устанавливается точность    //24/05/07
 //             0.001 для карт масштаба <= 500000;
 //             0.01 для карт масштаба более 500000; если precision больше предложенной; то
 //             устанавливается большее значение
 // Возвращает указатель на класс пересечения
 // При отсутствии пересечения или при ошибке возвращает 0


function mapCreateObjectsCross(aInfo1, aInfo2 : HOBJ; aMethod : integer;
                               aPrecision : double) : HCROSS;
  {$IFNDEF LINUXAPI} stdcall {$ELSE} cdecl {$ENDIF};
  external sGisAcces;
 // Пересечение двух объектов
 // Освобождение класса пересечения

 procedure mapFreeObjectsCross(aCross : HCROSS);
  {$IFNDEF LINUXAPI} stdcall {$ELSE} cdecl {$ENDIF};
  external sGisAcces;

 // Пересечение двух объектов
 // Запросить объект
 // Obj - результат
 // При ошибке возвращает 0

function mapGetNextCross(aCross : HCROSS; aInfo : HOBJ) : HOBJ;
  {$IFNDEF LINUXAPI} stdcall {$ELSE} cdecl {$ENDIF};
  external sGisAcces;

 // Запрос на пересечение двух объектов
 // Только для ПЛОЩАДНЫХ или ЛИНЕЙНЫХ объектов !!!
 // info1 - первый объект карты
 // info2 - второй объект карты
 // Если объекты пересекаются; возвращает 1
 // При ошибке или неверном типе объектов возвращает 0

function mapGetObjectsCross(aInfo1, aInfo2 : HOBJ) : integer;
  {$IFNDEF LINUXAPI} stdcall {$ELSE} cdecl {$ENDIF};
  external sGisAcces; 
Изменено: KFF - 20.02.2017 16:08:04
Не тот глуп кто не знает, а тот, кто не знает где искать.
 
Разобрался.
Спасибо.
procedure TfrmOvl.btnFindCrossObjClick(Sender: TObject);
var
res : integer;
begin
frmOvl.MapFind1.Active := false;
frmOvl.MapFind1.FindPoint := false;
frmOvl.MapFind1.MapSelect.Clear;
frmOvl.MapFind1.MapSelect.Excode[-1,0] := false;
frmOvl.MapFind1.MapSelect.Excode[10000017,OL_SQUARE] := true;
frmOvl.MapFind1.Active := true;
frmOvl.MapFind1.First;
frmOvl.MapFind2.Active := false;
frmOvl.MapFind2.FindPoint := false;
frmOvl.MapFind2.MapSelect.Clear;
frmOvl.MapFind2.MapSelect.Excode[-1,0] := false;
frmOvl.MapFind2.MapSelect.Excode[10000019,OL_SQUARE] := true;
frmOvl.MapFind2.Active := true;
frmOvl.MapFind2.First;
res := temp.SeekObject('TopoPlan', 2);
res := objIn.SeekObject('TopoPlan', 1);
try
res := ovlObj.CreateOVL(1, 0.001, 0, 0);
res := ovlObj.SetObjectCross(0, 0.001, 0, ovl_METHOD_SQUARE, ovl_ANYOBJECT);
objOut.CreateObjectByKey(1, KM_IDDOUBLE2, objIn.KeyName);
res := ovlObj.GetNextObject;
objOut.Commit;
mvMap.Repaint;
objOut.Style := OS_SELECT;
finally
ovlObj.FreeOVL;
end;
end;
 
Цитата
KFF написал:
// функция поиска пересечений. Возвращает площадь пересечения
function TMainForm.CalcCrossObject(ExtMap : HMap; baseObj, crossObj : HObj): double;
var cross   : HCross;
   obj     : HObj;
begin
 cross  := mapCreateObjectsCross(baseObj, crossObj, OL_SQUARE, 0.001);
 result := 0;
 if Cross=0 then exit;
 obj   := mapCreateSiteObject(ExtMap, ExtMap, KM_IDFLOAT3, 0);
 while mapGetNextCross(cross, obj)<>0 do
    result := result+mapSquareInMap(obj);
 mapFreeObjectsCross(cross);
 mapFreeObject(obj);
end;
Функция работает замечательно.
Большая просьба подсказать, что можно еще дописать в эту функцию,
на случай, если у пользователя в объекте crossObj
есть подобъект или подобъекты.
Пробовал:
// result := result+mapSquareInMap(obj);
result := result+mapConventionalSubjectSquare(obj, 1);
в результате не то вычисляет.
Изменено: Сергей Викторович - 23.01.2018 15:29:38
 
Цитата
Сергей Викторович написал:
есть подобъект или подобъекты.
Код
// функция поиска пересечений. Возвращает площадь пересечения
function CalcSquareCrossObject(Map : HMap; Site : HSite; baseObj, cutObj : HObj): double;
var cross  : HCross;
    obj    : HObj;
    i : integer;
    s : double;
begin
  result := 0;
  cross  := mapCreateObjectsCross(baseObj, cutObj, OL_SQUARE, 0.001);
  if cross=0 then exit;
  obj   := mapCreateSiteObject(Map, Site, KM_IDFLOAT3, 0);
  while mapGetNextCross(cross, obj)<>0 do
  begin
    S := mapSquareInMap(obj);
    for i := 2 to mapPolyCount(obj) do
       S := S - mapConventionalSubjectSquare(obj, i-1);
    result := result+ S;
  end;
  mapFreeObjectsCross(cross);
  mapFreeObject(obj);
end;

Пример вместе с картой и двумя объектами с дырками которые формируют пересечение одно из которых с "дыркой" СКАЧАТЬ
Не тот глуп кто не знает, а тот, кто не знает где искать.
 
Пытаюсь вычислить длину линейного объекта, который пересекает площадной объект.
Нужно определить длину линейного объекта, отрезок которого который внутри площадного объекта.

function CalcCrossObjectLength(ExtMap : HMap; baseObj, crossObj : HObj): double;
var cross   : HCross;
   obj     : HObj;
   i       : integer;
   n       : integer;
   LengthCross : double;
begin
 // Определяем действительно ли линейный объект crossObj пересекает площадной объект baseObj
 cross  := mapCreateObjectsCross(baseObj, crossObj,OL_LINE,0.001);
 ShowMessage ('cross = '+IntToStr(cross)); // Здесь все OK

 if cross=0 then exit;

 obj := mapCreateSiteObject (ExtMap, ExtMap, KM_IDFLOAT3, 0);
 ShowMessage ('obj = '+IntToStr(obj));  // Здесь все OK
 
  LengthCross := mapConventionalSubjectLength(obj, 0); // Здесь пытаюсь вычислить длину отрезка линейного объекта, кторый находится внутри площадного объекта
  ShowMessage ('LengthCross = '+FloatToStr(LengthCross)); // Здесь показывает 0
 
 mapFreeObjectsCross(cross);
 mapFreeObject(obj);
end;

Не понимаю, почему LengthCross равен нулю.
Просьба помочь разобраться.
 
Цитата
Сергей Викторович написал:
Код
   obj := mapCreateSiteObject (ExtMap, ExtMap, KM_IDFLOAT3, 0);
   ShowMessage ('obj = '+IntToStr(obj));  // Здесь все OK
   LengthCross := mapConventionalSubjectLength(obj, 0); // Здесь пытаюсь вычислить длину отрезка линейного объекта, кторый находится внутри площадного объекта
   ShowMessage ('LengthCross = '+FloatToStr(LengthCross)); // Здесь показывает 0

Вы создали объект, ничего в него не заполнили и запрашиваете его длину.
Ноль - корректное значение для вновь созданного пустого объекта.
 
Да, я понимаю, что объект создан.
Но как передать в него параметры,
которые характеризуют длину отрезка линейного объекта,
который попадает во внутрь площадного объекта, не понимаю.
Просьба написать несколько строк кода,
которые реализуют вычисление длины отрезка линейного объекта,
который находится внутри площадного объекта при их пересечении.
Спасибо.
Изменено: Сергей Викторович - 16.11.2018 16:39:07
 
Должно быть примерно так:

Цитата
Сергей Викторович написал:
function CalcCrossObjectLength(ExtMap : HMap; baseObj, crossObj : HObj): double;
var cross   : HCross;
  obj     : HObj;
  i       : integer;
  n       : integer;
  LengthCross : double;
begin
// Определяем действительно ли линейный объект crossObj пересекает площадной объект baseObj
cross  := mapCreateObjectsCross(baseObj, crossObj,OL_LINE,0.001);
ShowMessage ('cross = '+IntToStr(cross)); // Здесь все OK

if cross=0 then exit;

obj := mapCreateSiteObject (ExtMap, ExtMap, KM_IDFLOAT3, 0);
ShowMessage ('obj = '+IntToStr(obj));  // Здесь все OK

// Заполнить в объект пересечение в obj (пересечений может быть много)
while (mapGetNextCross(cross, obj) <> 0) do
  begin

      LengthCross := mapConventionalSubjectLength(obj, 0); // Здесь пытаюсь вычислить длину отрезка линейного объекта, кторый находится внутри площадного объекта
      ShowMessage ('LengthCross = '+FloatToStr(LengthCross)); // Здесь показывает 0
  end;
 
mapFreeObjectsCross(cross);
mapFreeObject(obj);
end;

Код писал прямо тут, в Delphi не проверял. Если что, подправьте.
Суть, думаю, понятна.
Страницы: 1 2 След.
Читают тему (гостей: 1)



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

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