forum.datacad.com

Posted: **Mon Jul 31, 2017 6:48 pm**

Hi,
I'm having trouble with the PntInPoly function provided in the DCAL for Delphi libraries. It kept crashing when called in an Offset macro I am writing, so I checked all the passed parameters in Debugger and they all appeared to be initialised with valid values. In desperation I wrote the simple test program as below:

Code: Select all

library Tests;

uses
  System.sysutils,
  //DCAL for Delphi Header Files
  UConstants in '../../Header Files/UConstants.pas',
  UInterfaces in '../../Header Files/UInterfaces.pas',
  UInterfacesRecords in '../../Header Files/UInterfacesRecords.pas',
  URecords in '../../Header Files/URecords.pas',
  UVariables in '../../Header Files/UVariables.pas';

{$E dmx}  //dmx is the extension for DCAL Dll's
{$R *.res}



function Main(dcalstate : asint; act : action; pl, pargs : Pointer) : wantType; stdcall;
var
  testpnt, minpt, maxpt : point;
  ply : polyarr;
  i : integer;
  arg : getIntArg;
  res : asInt;

begin
  setpoint(testpnt, 0.0);
  ply[1].x := -100;
  ply[1].y := -100;
  ply[2].x := -100;
  ply[2].y := 100;
  ply[3].x := 100;
  ply[3].y := 100;
  ply[4].x := 100;
  ply[4].y := -100;
  for i:= 1 to 4 do ply[i].z := 0.0;
  minpt := ply[1];
  maxpt := ply[3];
  i := pntinpoly(testpnt, ply, 4, minpt, maxpt);
  getint (i, arg, res);

  Result := XDone;
end;

exports
   Main;

begin

end.

This test program also falls over on the PntInPoly call. It gets the exact same exception as my Offset macro: exception class $C0000005 with message 'access violation at 0x00000000: read of address 0x00000000'.

There seem to be a lot of zeros in the addresses in the error message, which makes me think something might not be initialised?

Perhaps I am doing something wrong and should be initialising something else before making the call? If there is an error in the above code I would be grateful if somebody could help me out. Sometimes I miss the obvious, but at the moment I'm thinking there may be a bug in the D4D function ...

Thanks,
David H

Posted: **Tue Aug 01, 2017 1:53 pm**

It appears that the D4D pntinpoly function is in fact unusable (I am not the only one who has found that it crashes the drawing).

For anybody interested I have written my own PntInPly function which appears to work ok (based on some Classic DCAL code in the Shadow macro which has had quite a bit of testing ... although it didn't crash, I found the result of the Classic DCAL pnt_in_poly function to be unreliable).

Here is the code for my PntInPly function:

Code: Select all

unit PntUtil;

interface

uses  UConstants, UInterfaces, UInterfacesRecords, URecords;

FUNCTION PntsEqual (p1, p2 : point; delta : real) : boolean;
FUNCTION  PntInPly (pnt : point;
                              ply : array of point;
                              npnt : integer) : integer;

implementation

const
   weedist = 1E-10;

FUNCTION PntsEqual (p1, p2 : point; delta : real) : boolean;
BEGIN
   result := (abs(p1.x-p2.x) <= delta) and (abs(p1.y-p2.y) <= delta);
END;


FUNCTION  PntInPly (pnt : point;
                              ply : array of point;
                              npnt : integer) : integer;
/// this function will return the following values:
///    1  if pnt is inside ply
///    0  if pnt is on the boundary of ply
///    -1 if pnt is outside ply
VAR
   i, j               : integer;
   ospnt               : point;    { a point set up to be outside ply }
   minx, maxx,
   miny, maxy      : real;
   retval            : integer;
   satisfactory   : boolean;
   intr               : point;
   xcount            : integer;
   trycount         : integer;
   ent                  : entity;

BEGIN
   minx := ply[1].x;
   maxx := minx;
   miny := ply[1].y;
   maxy := miny;

   // check if on a boundary and also set up min & max x & y values
   for i := 1 to npnt do begin
      if ply[i].x < minx then
         minx := ply[i].x;
      if ply[i].x > maxx then
         maxx := ply[i].x;
      if ply[i].y < miny then
         miny := ply[i].y;
      if ply[i].y > maxy then
         maxy := ply[i].y;

      j := i+1;
      if j > npnt then
         j := 1;

    if pntsEqual (pnt, ply[i], weeDist) then begin
      result := 0;
      exit;
    end;
      if dis_from_seg (ply[i], ply[j], pnt) < weeDist then begin
      result := 0;
      exit;
     end;
  end;

   // check if point is outside bounding rectangle (defined by min & max x & y values)
   if (pnt.x < minx) or (pnt.x > maxx) or (pnt.y < miny) or (pnt.y > maxy) then begin
      result := -1;
    exit;
   end;

   // set up ospnt to a point outside the bounding rectangle
   ospnt.x := minx-1.0;
   ospnt.y := miny + (maxy - miny)/2.0;

   // check how many times a line from ospnt to pnt crosses ply boundary
   // An odd number of times indicates that pnt is inside ply
   // An even number of times indicates that pnt is outside ply
   repeat
      satisfactory := true;
      trycount := 0;
      xcount := 0;
      for i := 1 to npnt do begin
         j := i+1;
         if j > npnt then
            j := 1;

         if intr_linlin (ospnt, pnt, ply[i], ply[j], intr, true) then begin
            if PntsEqual (intr, ply[i], weeDist) or PntsEqual (intr, ply[j], weeDist) then begin
               // looks like our line goes though one of the points  ... result may not be reliable
               satisfactory := false;
               trycount := trycount+1;
               if PntsEqual (intr, ply[i], ABSZero) then
                  xcount := xcount+1;

          ospnt.y := ospnt.y + (maxy - miny)/25; // move ospnt slightly for next iteration
        end
            else
               xcount := xcount+1;
         end;
      end;
   until satisfactory or (trycount > 15);

   if xcount mod 2 = 0 then
      result := -1
   else
      result := 1;
END;

end.

Regards,
David H

Posted: **Tue Aug 01, 2017 2:01 pm**

oops. I pasted a copy of some old (faulty) code in my last post. The correct code for my PntInPly function is pasted below:

Code: Select all

unit PntUtil;

interface

uses  UConstants, UInterfaces, UInterfacesRecords, URecords;

FUNCTION PntsEqual (p1, p2 : point; delta : real) : boolean;
FUNCTION  PntInPly (pnt : point;
                              ply : array of point;
                              npnt : integer) : integer;

implementation

const
   weedist = 1E-10;

FUNCTION PntsEqual (p1, p2 : point; delta : real) : boolean;
BEGIN
   result := (abs(p1.x-p2.x) <= delta) and (abs(p1.y-p2.y) <= delta);
END;


FUNCTION  PntInPly (pnt : point;
                              ply : array of point;
                              npnt : integer) : integer;
/// this function will return the following values:
///    1  if pnt is inside ply
///    0  if pnt is on the boundary of ply
///    -1 if pnt is outside ply
VAR
   i, j               : integer;
   ospnt               : point;    { a point set up to be outside ply }
   minx, maxx,
   miny, maxy      : real;
   retval            : integer;
   satisfactory   : boolean;
   intr               : point;
   xcount            : integer;
   trycount         : integer;
   ent                  : entity;

BEGIN
   minx := ply[1].x;
   maxx := minx;
   miny := ply[1].y;
   maxy := miny;

   // check if on a boundary and also set up min & max x & y values
   for i := 1 to npnt do begin
      if ply[i].x < minx then
         minx := ply[i].x;
      if ply[i].x > maxx then
         maxx := ply[i].x;
      if ply[i].y < miny then
         miny := ply[i].y;
      if ply[i].y > maxy then
         maxy := ply[i].y;

      j := i+1;
      if j > npnt then
         j := 1;

    if pntsEqual (pnt, ply[i], weeDist) then begin
      result := 0;
      exit;
    end;
      if dis_from_seg (ply[i], ply[j], pnt) < weeDist then begin
      result := 0;
      exit;
     end;
  end;

   // check if point is outside bounding rectangle (defined by min & max x & y values)
   if (pnt.x < minx) or (pnt.x > maxx) or (pnt.y < miny) or (pnt.y > maxy) then begin
      result := -1;
    exit;
   end;

   // set up ospnt to a point outside the bounding rectangle
   ospnt.x := minx-1.0;
   ospnt.y := miny + (maxy - miny)/2.0;

   // check how many times a line from ospnt to pnt crosses ply boundary
   // An odd number of times indicates that pnt is inside ply
   // An even number of times indicates that pnt is outside ply
   repeat
      satisfactory := true;
      trycount := 0;
      xcount := 0;
      for i := 1 to npnt do begin
         j := i+1;
         if j > npnt then
            j := 1;

         if intr_linlin (ospnt, pnt, ply[i], ply[j], intr, true) then begin
            if PntsEqual (intr, ply[i], weeDist) or PntsEqual (intr, ply[j], weeDist) then begin
               // looks like our line goes though one of the points  ... result may not be reliable
               satisfactory := false;
               trycount := trycount+1;
               if PntsEqual (intr, ply[i], ABSZero) then
                  xcount := xcount+1;

        end
            else
               xcount := xcount+1;
         end;
      end;
    if not satisfactory then
      ospnt.y := ospnt.y + (maxy - miny)/25; // move ospnt slightly for next iteration
   until satisfactory or (trycount > 15);

   if xcount mod 2 = 0 then
      result := -1
   else
      result := 1;
END;

end.

[/list]

forum.datacad.com

Bug in PntInPoly function ? (Dcal for Delphi)

Bug in PntInPoly function ? (Dcal for Delphi)

Re: Bug in PntInPoly function ? (Dcal for Delphi)

Re: Bug in PntInPoly function ? (Dcal for Delphi)