CALCAD Posted May 14, 2009 Posted May 14, 2009 Does anyone know of a lisp or a method for determining if a point is inside (or outside) of a closed 2D boundary of arbitrary shape? Edit : Well, as soon as I posted, I saw the list of previous posts on the subject. I'll be studying for awhile. Thanks to all previous posters. Quote
Lee Mac Posted May 14, 2009 Posted May 14, 2009 Give this a shot: [i][color=#990099];; ============ Insidep.lsp ===============[/color][/i] [i][color=#990099];;[/color][/i] [i][color=#990099];; MAIN FUNCTION DESCRIPTION:[/color][/i] [i][color=#990099];; Will determine whether a point lies[/color][/i] [i][color=#990099];; inside or outside an object.[/color][/i] [i][color=#990099];;[/color][/i] [i][color=#990099];; FUNCTION: insidep[/color][/i] [i][color=#990099];; ARGUMENTS:[/color][/i] [i][color=#990099];; Point to be tested.[/color][/i] [i][color=#990099];; Object Ename or VLA-Object[/color][/i] [i][color=#990099];;[/color][/i] [i][color=#990099];; FUNCTION: vlax-list->3D-point[/color][/i] [i][color=#990099];; ARGUMENTS:[/color][/i] [i][color=#990099];; List to be converted.[/color][/i] [i][color=#990099];; Flag to determine x or y.[/color][/i] [i][color=#990099];;[/color][/i] [i][color=#990099];; OBJECT COMPATIBILITY:[/color][/i] [i][color=#990099];; Everything except Viewport/Polygon Mesh.[/color][/i] [i][color=#990099];;[/color][/i] [i][color=#990099];; AUTHOR:[/color][/i] [i][color=#990099];; Copyright (c) 2009, Lee McDonnell[/color][/i] [i][color=#990099];; (Contact Lee Mac, CADTutor.net)[/color][/i] [i][color=#990099];;[/color][/i] [i][color=#990099];; PLATFORMS:[/color][/i] [i][color=#990099];; No Restrictions,[/color][/i] [i][color=#990099];; only tested in ACAD 2004.[/color][/i] [i][color=#990099];;[/color][/i] [i][color=#990099];; ========================================[/color][/i] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] insidep [b][color=RED]([/color][/b]pt Obj [b][color=BLUE]/[/color][/b] Obj Tol ang doc spc flag int lin xV yV[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=DARKRED]'[/color][/b]VLA-OBJECT [b][color=RED]([/color][/b][b][color=BLUE]type[/color][/b] Obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Obj [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] Obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Tol [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] pi [b][color=#009900]6[/color][/b][b][color=RED])[/color][/b] [i][color=#990099]; Uncertainty[/color][/i] ang [b][color=#009999]0.0[/color][/b] flag [b][color=BLUE]T[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-Acad-Object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] spc [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-activespace[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]=[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-mspace[/color][/b] doc[b][color=RED])[/color][/b] :vlax-true[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-modelspace[/color][/b] doc[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-paperspace[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-modelspace[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] ang [b][color=RED]([/color][/b][b][color=BLUE]*[/color][/b] [b][color=#009900]2[/color][/b] pi[b][color=RED])[/color][/b][b][color=RED])[/color][/b] flag[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] flag [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] int [b][color=RED]([/color][/b][b][color=BLUE]vlax-invoke[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lin [b][color=RED]([/color][/b][b][color=BLUE]vla-addLine[/color][/b] spc [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] pt[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] pt ang [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-property-available-p[/color][/b] Obj [b][color=DARKRED]'[/color][/b][b][color=BLUE]length[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-length[/color][/b] Obj[b][color=RED])[/color][/b] [b][color=#009999]1.0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b]IntersectWith Obj [b][color=Blue]acExtendThisEntity[/color][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] [b][color=#009900]6[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]length[/color][/b] int[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] xV [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] [b][color=RED]([/color][/b]vlax-list->3D-point int [b][color=BLUE]T[/color][/b][b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]<[/color][/b][b][color=RED])[/color][/b] yV [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b] [b][color=RED]([/color][/b]vlax-list->3D-point int [b][color=BLUE]nil[/color][/b][b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]<[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] xV[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] pt[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]last[/color][/b] xV[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] yV[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] pt[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]last[/color][/b] yV[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] ang [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] ang Tol[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-delete[/color][/b] lin[b][color=RED])[/color][/b][b][color=RED])[/color][/b] flag[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] vlax-list->3D-point [b][color=RED]([/color][/b]lst flag[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] lst [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] flag car cadr[b][color=RED])[/color][/b] lst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]vlax-list->3D-point [b][color=RED]([/color][/b][b][color=BLUE]cdddr[/color][/b] lst[b][color=RED])[/color][/b] flag[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [i][color=#990099];; Test Function[/color][/i] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:test [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] pt ss[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]sssetfirst[/color][/b] [b][color=BLUE]nil[/color][/b] [b][color=BLUE]nil[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] pt [b][color=RED]([/color][/b][b][color=BLUE]getpoint[/color][/b] [b][color=#ff00ff]"\nSelect Point Within Boundary: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"X"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#ff00ff]"~VIEWPORT"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"CTAB"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]410[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"CTAB"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]67[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=#009900]1[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TILEMODE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\nSelecting Everything Visible...\nAnalyzing Surrounding Region..."[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]cadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssnamex[/color][/b] ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b]insidep pt ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] ent ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]sslength[/color][/b] ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]sssetfirst[/color][/b] [b][color=BLUE]nil[/color][/b] ss[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\nPoint Does not lie Within Boundary!"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n<!> No Point Selected or No Objects in Drawing <!>"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Quote
CALCAD Posted May 14, 2009 Author Posted May 14, 2009 As usual Lee, you are a very quick responder. Thanks for the code, but unfortunately, I can't use Visual Lisp. If the Visual functions have equivalents in the old style Autolisp, I may be able to convert this. Edit : On second look, this would be very complex for me to convert. I'll have to search for a different solution. Quote
Lee Mac Posted May 14, 2009 Posted May 14, 2009 In my opinion, I doubt you will have success in finding a solution without using Visual LISP or vast amounts of coding. :wink: Quote
CALCAD Posted May 25, 2009 Author Posted May 25, 2009 Here is what I came up with. ; boundpt.lsp - to test the method of checking for a point within a bounding ; polygon by counting the intersections of a ray drawn from the ; point to be checked with the boundary. ; A point within the boundary will always have an odd number ; of intersections of the ray with the boundary. A point ; outside will always have an even number of intersections of ; the ray with the boundary. This is true regardless of the ; complexity of the boundary topology. ; There are, of course, potential problems that can occur. ; For example, what is to be done when the ray intersects a ; point just at the corner where a pair of segments meets? ; Or if the ray aligns precisely with a segment? This program ; handles these glancing cases by using multiple rays with a ; majority vote determination of the total number of ; intersections. ; This program is limited to polygons of line segments only, ; no polylines and no arcs. This demo program assumes the ; drawing consists of one closed boundary with any number of ; point entities distributed inside and outside the boundary. ; All entities must be visible for proper operation. At the ; end of processing, the set of all points within the ; boundary is selected and highlighted. ; ; On a 1.6 MHz processor with 2 Gb RAM, and a boundary of 60 ; segments, this program checks about 26 points per second. ; random number generator to randomize the ray angles (defun rnd (/ modulus multiplier increment random) (if (not seed) (setq seed (getvar "DATE")) ) (setq modulus 65536 multiplier 25173 increment 13849 seed (rem (+ (* multiplier seed) increment) modulus) random (/ seed modulus) ) ) ; main (defun c:bpt (/ sscl cl_ln n cl_ed cl_en points_1 points_2 raylen rayang pt ppt1 ppt2 copy_cl ipt ef ic vlist sumc xmx xmn pt ptset pt_ln pt_en pt_ed loc_points oldcolor boundset) (setq sscl (ssget "X" '((0 . "LINE")))) ; get set of all lines (if sscl (setq cl_ln (sslength sscl)) ) (setq n 0) (if sscl ; not nil, store start and end points in list (progn (repeat cl_ln (setq cl_en (ssname sscl n)) (setq cl_ed (entget cl_en)) (setq points_1 (cons (cdr (assoc 10 cl_ed)) points_1)) ; save start point (setq points_2 (cons (cdr (assoc 11 cl_ed)) points_2)) ; save end point (setq n (+ n 1)) ) ) ) (setq xmx (getvar "EXTMAX")) (setq xmn (getvar "EXTMIN")) (setq raylen (distance xmx xmn)) (setq boundset (ssadd)) ; initialize in-bounds point set (setq ptset (ssget "X" '((0 . "POINT")))) (if ptset (setq pt_ln (sslength ptset)) ) (setq n 0) (if ptset ; not nil, store X Y location of points in list (progn (repeat pt_ln (setq pt_en (ssname ptset n)) (setq pt_ed (entget pt_en)) (setq loc_points (cons (cdr (assoc 10 pt_ed)) loc_points)) ; save point location (setq n (+ n 1)) ) ) ) (setq np (- pt_ln 1)) (repeat pt_ln (setq pt (car loc_points)) (setq loc_points (cdr loc_points)) (setq vlist nil) (setq ic 0) (setq n 0) (setq rayang (* (/ pi 1.5) (rnd))) ; for 3 rays (repeat 3 ; simulate 3 lines at random angles (while (< n cl_ln) ; check every segment of boundary for intersection (setq ppt1 (nth n points_1)) (setq ppt2 (nth n points_2)) (setq ipt (inters pt (polar pt rayang raylen) ppt1 ppt2)) (if ipt (setq ic (+ ic 1)) ) (setq n (+ n 1)) ) ; end inner loop (if (= (- (/ ic 2.0) (fix (/ ic 2.0))) 0) (setq ef 1) (setq ef 0) ) (setq ic 0) (setq n 0) (setq vlist (cons ef vlist)) (setq rayang (+ rayang (/ pi 1.5) (* (/ pi 1.5) (rnd)))) ; get new angle ) ; end outer loop (setq sumc (apply '+ vlist)) (if (not (or (= sumc 0) (= sumc 3))) (progn (princ "\n **** vote taken ****") (if (> sumc 1) (setq ef 1) ; for 3 lines (setq ef 0) ) ) ) (if (= ef 0) (ssadd (ssname ptset np) boundset) ) (setq np (- np 1)) ) (sssetfirst boundset boundset) (setq sscl nil) (setq ptset nil) (setq boundset nil) (princ) ) One strange thing I encountered while writing this program : My first version used nested REPEAT loops. Once it was working, I noticed that the execution time increased in a regular way with every trial within the same drawing session. With a new drawing, the clock was, as it were, reset. After playing around a bit, I concluded that changing either the inner or outer loop to a WHILE eliminated the lengthening execution time. So at least for Intellicad's Lisp implementation, the advice is don't use nested REPEAT loops if the program will be used repeatedly in the same drawing, or performance will gradually degrade. I wonder if this is true with Autolisp or Visual lisp. Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.