The DataCAD Developer Network (DDN) is an online resource for information and support for DCAL® (DataCAD Applications Language) developers as well as anyone interested in creating fonts, toolbars, hatch patterns, or linetypes for use in DataCAD.

Moderator: pjdixit

#71961 by dhs
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 alllibrary 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
#71974 by dhs
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 allunit 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
#71975 by dhs
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 allunit 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]

Who is online

Users browsing this forum: No registered users and 1 guest

About DataCAD Forum

The DataCAD Forum is a FREE online community we provide to enhance your experience with DataCAD.

We hope you'll visit often to get answers, share ideas, and interact with other DataCAD users around the world.

DataCAD

Software for AEC Professionals Since 1984