wkplan Posted August 13, 2009 Posted August 13, 2009 Hello all, I'm not sure if I'd better quotedt this to the origin thread, but I think this topic needs his own title. Anyway, there are many, many routines available for checking if a point is inside a polygon. All I have seen so far will only tell "yes or no"... Well that is surely interessting in most cases, but I would like to know what polyline -especially the handle of it- surrounds a given point. I took a look at Lee Mac's progn here: Just thinking out loud: and feed id with some points given by an outer loop, hopefully the bSs-variable will hold the handle, but that didn't come true. A tried to understand what Lee did within his code, and added some debuging informations to it. (Just tracing the values of variables used) Here is the result (for e.g. 21 points tested, all of them are definitive within a unique closed polyline): Point:---->(181.692 150.603 0.0) ent--->nil bSs--><Selection set: 33eb> items in bSs-->0 VLIST--->nil Point:---->(187.882 183.041 0.0) ent--->nil bSs--><Selection set: 33f3> items in bSs-->0 VLIST--->nil Point:---->(149.779 144.875 0.0) ent--->nil bSs--><Selection set: 33fb> items in bSs-->0 VLIST--->nil Point:---->(152.73 147.827 0.0) ent--->nil bSs--><Selection set: 3403> items in bSs-->0 VLIST--->nil Point:---->(142.74 147.642 0.0) ent--->nil bSs--><Selection set: 340b> items in bSs-->0 VLIST--->nil Point:---->(148.671 153.578 0.0) ent--->nil bSs--><Selection set: 3413> items in bSs-->0 VLIST--->nil Point:---->(145.72 150.63 0.0) ent--->nil bSs--><Selection set: 341b> items in bSs-->0 VLIST--->nil Point:---->(130.852 183.041 0.0) ent--->nil bSs--><Selection set: 3423> items in bSs-->0 VLIST--->nil Point:---->(121.682 153.571 0.0) ent--->nil bSs--><Selection set: 342b> items in bSs-->0 VLIST--->nil Point:---->(88.6659 176.741 0.0) ent--->nil bSs--><Selection set: 3433> items in bSs-->0 VLIST--->nil Point:---->(59.7492 178.667 0.0) ent--->nil bSs--><Selection set: 343b> items in bSs-->0 VLIST--->nil Point:---->(64.4148 178.435 0.0) ent--->nil bSs--><Selection set: 3443> items in bSs-->0 VLIST--->nil Point:---->(62.103 171.224 0.0) ent--->nil bSs--><Selection set: 344b> items in bSs-->0 VLIST--->nil Point:---->(58.3778 167.412 0.0) ent--->nil bSs--><Selection set: 3453> items in bSs-->1 VLIST--->nil Point:---->(73.8206 183.041 0.0) ent--->nil bSs--><Selection set: 345e> items in bSs-->0 VLIST--->nil Point:---->(65.4971 174.618 0.0) ent--->nil bSs--><Selection set: 3466> items in bSs-->0 VLIST--->nil Point:---->(91.6512 220.023 0.0) ent--->nil bSs--><Selection set: 346e> items in bSs-->1 VLIST--->nil Point:---->(59.6568 230.425 0.0) ent--->nil bSs--><Selection set: 3479> items in bSs-->1 VLIST--->nil Point:---->(65.1193 230.429 0.0) ent--->nil bSs--><Selection set: 3484> items in bSs-->1 VLIST--->nil Point:---->(196.504 229.156 0.0) ent--->nil bSs--><Selection set: 348f> items in bSs-->1 VLIST--->nil Point:---->(189.714 221.54 0.0) ent--->nil bSs--><Selection set: 349a> items in bSs-->1 VLIST--->nil As you can see, all points are processed, the loop is complete ( ent = nil ) bSs stores a new selection set, but in most cases there is nothing inside... Is there a chance to retrieve the correct handle? Or maybee anyone has another function? Below you will read Lee's code, I took his first version for testing. (defun c:pBound (/ iPt ss bSs vLst vT x+y+ x-y+ x+y- x-y-) (sssetfirst nil nil) (if (and (setq iPt (getpoint "\nSelect Point inside Pline: ")) (setq ss (ssget "X" (list (cons 0 "LWPOLYLINE") (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))) (progn (setq bSs (ssadd)) (foreach ent (mapcar 'cadr (ssnamex ss)) (setq vLst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq 10 (car x))) (entget ent)))) (while vLst (setq vT (car vLst)) (cond ((and (<= (car iPt) (car vT)) (<= (cadr iPt) (cadr vT))) (setq x+y+ T)) ((and (<= (car vT) (car iPt)) (<= (cadr iPt) (cadr vT))) (setq x-y+ T)) ((and (<= (car iPt) (car vT)) (<= (cadr vT) (cadr iPt))) (setq x+y- T)) ((and (<= (car vT) (car iPt)) (<= (cadr vT) (cadr iPt))) (setq x-y- T))) (setq vLst (cdr vLst))) (if (and x+y+ x-y+ x+y- x-y-) (ssadd ent bSs)) (setq x+y+ nil x-y+ nil x+y- nil x-y- nil)) (sssetfirst nil bSs)) (princ "\n<!> No LWPolylines Found <!>")) (princ)) Regards Wolfgang Quote
ronjonp Posted August 13, 2009 Posted August 13, 2009 I'm not exactly sure what you are trying to do but give this a try. I made Lee's routine accept a point and output an ename if found. Then you can cycle through your points and output a list of enames. (defun pbound (ipt / ss bss vlst vt x+y+ x-y+ x+y- x-y- result) (sssetfirst nil nil) (if (setq ss (ssget "X" (list (cons 0 "LWPOLYLINE") (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE"))) ) ) ) ) (progn (foreach ent (mapcar 'cadr (ssnamex ss)) (setq vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq 10 (car x))) (entget ent)))) (while vlst (setq vt (car vlst)) (cond ((and (<= (car ipt) (car vt)) (<= (cadr ipt) (cadr vt))) (setq x+y+ t)) ((and (<= (car vt) (car ipt)) (<= (cadr ipt) (cadr vt))) (setq x-y+ t)) ((and (<= (car ipt) (car vt)) (<= (cadr vt) (cadr ipt))) (setq x+y- t)) ((and (<= (car vt) (car ipt)) (<= (cadr vt) (cadr ipt))) (setq x-y- t)) ) (setq vlst (cdr vlst)) ) (if (and x+y+ x-y+ x+y- x-y-) (setq result ent) ) (setq x+y+ nil x-y+ nil x+y- nil x-y- nil ) ) ) ) result ) (foreach point pointlist (if (setq e (pbound point)) (setq out (cons e out)) ) ) Quote
Lee Mac Posted August 13, 2009 Posted August 13, 2009 Wolfgang, I updated that version significantly, here is the latest: [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] [b][color=BLUE]pi[/color][/b] [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] [b][color=Blue]:vlax-true[/color][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] [b][color=BLUE]pi[/color][/b][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 [b][color=Blue]car cadr[/color][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
wkplan Posted August 14, 2009 Author Posted August 14, 2009 maybee my wishes are too big. @Lee, thanks for answer, I've seen the updated routine before, but I took your first one because it seems easy to implement it in some other code. @ronjonp, I don't need the point-names, I allready know the points, and they are stored in a point list. What I am trying to do: - I have some points inside various polylines, I know the point-coordinates - Lee's first routine grabs all polylines, put them in a selection-set and tests, if a given point is inside one of these polylines. (if (and(setq iPt (getpoint "\nSelect Point inside Pline: ")) (setq ss (ssget "X" (list (cons 0 "LWPOLYLINE") (if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))) (progn By changing (setq iPt (getpoint "\nSelect Point inside Pline: ")) to (setq iPt p1) I can feed Lee's function with my points. This part works well. Now lets go back to the selection set: It containes all polylines. Lee's code loops through all of them, tests if the point (lets call it p1) is inside the first polyline of the selection-set. If not, the first polyline will be removed from the selection-set and the testing goes on. This is done till the length of the selection set. At some time, the selection set must contain the name of a polyline that surrounds p1, and that's what I'm going for. The purpose of my debugging was only to see, if there is a name I can grab. The purpose of the hole procedure is to hatch the found polyline. This can be done easy by throwing the point p1 inside the hatch-command, but on large drawings this soon becommes vv e r r y ss l o w... Feeding bhatch with a object-name incredibly speeds up this part of work. That's why I want to retrieve the object-name/handle of the polyline. Lee, ronjonp, I tested both of your routines, thanks for sharing it. At the first look, there is no way to determine the name of the polyline, or did I misunderstood something? (Lee's test uses the boundary-function, this also grows verry slow on large drawings) Is there any other way to do the job? Regards Wolfgang Quote
Lee Mac Posted August 14, 2009 Posted August 14, 2009 Wolfgang, my function will perform as needed, you just need to slightly modify the test function I have supplied. You could perhaps alter the IF statement to make so it that if the test returns T, then return that polyline... There are many many ways around this. Another thought just popped into my head, instead of using a foreach loop, you could use a while loop inside a vl-catch-all-apply, and use the (exit) function to exit the loop when the polyline is found. The vl-catch-all-apply will then prevent the program from stopping, and will prevent the need to iterate through the whole set each time. Just an idea :wink: Quote
wkplan Posted August 14, 2009 Author Posted August 14, 2009 Lee, thank you again. Now I know where I am this weekend and what I will do... regards Wolfgang Quote
Lee Mac Posted August 14, 2009 Posted August 14, 2009 Haha If you need any help doing it, just shout Lee Quote
wkplan Posted August 17, 2009 Author Posted August 17, 2009 Hello all, and special greetings to ronjonp and Lee Mac. Weather was fine, we had at least 34 degrees , no clouds, no rain @ronjonp: I owe you an apology, i have found the routine you modified for me is easy to manage and I can put it in the rest of my code. Found this out just a few seconds ago, didn't noticed that I had to add (defun pBound (/ iPt ss bSs vLst vT x+y+ x-y+ x+y- x-y-) (sssetfirst nil nil) (if [color=Blue](and (setq iPt p1)[/color] (setq ss (ssget "_X" (list (cons 0 "LWPOLYLINE") to make it work. Thank you for the support. @Lee Mac: I have to admit, I still have no idea how I can change your code in that way it returns me an ename. Tried it nearly the rest of friday, no way. I then tried the closepline.lsp, posted by ronjonp, and this time I was able to put it in my code and it works now. That was friday night 23:30, I was as happy as anyone can be and decided to take some beero:) Saturday morning (maybee in the midday heat) I woke up (was not easy, someone did some terrible things with my head...) and started to comment every line of code i had written. (That because I am an absolute beginner in lisp, although loading them for years, never looked closer. Hopefully that will change by now on.) It works pretty quick, because hatch works much faster if a boundary object is given as a parameter to the command, the difference is significant. But I noticed, that the closepl.lsp ist not perfect, in some cases it reports the wrong polyline: If a polyline has direct contact to another polyline, it is not quite sure, that the intended LWPOLYLINE is really found. There may be cases, the wrong polyline is found, because the programm searches all Polylines, calculate the distance and put them in a list. That means, the list can contain two ore more entrys matching the closest distance, and the programm takes the first entry in that list, without proofing if there is another entry. Lee, can you show me how to modify the test-function? regards Wolfgang Quote
Lee Mac Posted August 17, 2009 Posted August 17, 2009 Hi Wolfgang, Glad you had a good weekend, and the weather was good for you. As I say, there are many ways to modify the test function to suit your needs - some may be quicker than others. Here are a few of my ideas: ;; Test Function (defun c:test (/ pt i ss ent) (vl-load-com) (if (and (setq pt (getpoint "\nSelect Point Within Boundary: ")) (setq i -1 ss (ssget "X" (list (cons 0 "~VIEWPORT"))))) (vl-catch-all-apply (function (lambda ( ) (while (setq ent (ssname ss (setq i (1+ i)))) (if (insidep pt ent) (exit) (setq ent nil))))))) ent) ;; Test Function (defun c:test (/ pt ss ent sel) (vl-load-com) (if (and (setq pt (getpoint "\nSelect Point Within Boundary: ")) (setq ss (ssget "X" (list (cons 0 "~VIEWPORT"))))) (progn (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (insidep pt Obj) (setq ent (vlax-vla-object->ename Obj)))) (vla-delete sel))) ent) ;; Test Function (defun c:test (/ pt ss ent Obj) (vl-load-com) (if (and (setq pt (getpoint "\nSelect Point Within Boundary: ")) (setq ss (ssget "X" (list (cons 0 "~VIEWPORT"))))) (foreach ent (mapcar 'cadr (ssnamex ss)) (if (insidep pt ent) (setq Obj ent)))) Obj) But there are many many more. Quote
wkplan Posted August 17, 2009 Author Posted August 17, 2009 Lee, thank you! I'll take a look at your code tomorrow. regards Wolfgang Quote
Freerefill Posted August 18, 2009 Posted August 18, 2009 Just something to think about... (defun inpoly(point coords / ); (vl-load-com) (not (zerop (rem (/ (length (vl-remove nil (mapcar '(lambda (x y) (inters point (list (1+ (apply 'max (mapcar 'car coords))) (1+ (apply 'max (mapcar 'cadr coords))) 0) x y T)) coords (append (cdr coords) (list (car coords)))))) 2.0) 1.0))) ) This function requires a point and a list of coordinates, representing a polygon. It then checks to see if the point is within those coordinates. I haven't used the IntersectWith method, yet, I can still test to see if something is "inside" something else. Obviously getting the coordinates is a whole other ball of wax, but this will at least work for the check. One thing I've been wondering about, but have yet to test, is whether this is more efficient than the IntersectWith method. Just food for thought. ^.^ Quote
Lee Mac Posted August 18, 2009 Posted August 18, 2009 Nice idea Mark, But as it uses a fixed vector, it can be fooled with L-Shapes Quote
wkplan Posted August 18, 2009 Author Posted August 18, 2009 "...you just need to slightly modify the test function I have supplied." Hi Lee, to me it seems the three Test-Functions you gave, they have been changed a lot... Anyway, I finally made it, mixing your function with the rest of my code and now it works. Works good! Especially your function determines clear, which polyline surrounds a point complete, so if two or more polylines have the same distance to a point, the correct polyline is reportet. There is one strange issue: - if I feed the ename to the ._-bhatch-command, it will stop after the first hatch, then only draws a short line into the boudary. (I think the line comes from the vla-addline-code). But this occurs only, if HPNAME is set to "SOLID". If HPNAME is set to e.g. "ANGLE", it works. I changed your test-function to: [color=Blue](defun test (/ pt i ss ent)[/color] (vl-load-com) (if (and (setq pt p1) [color=Blue]; deleted the getpoint-function, set pt=p1 which comes from an outer loop[/color] (setq i -1 ss (ssget "_X" (list (cons 0 "~VIEWPORT"))))) (vl-catch-all-apply (function (lambda () (while (setq ent (ssname ss (setq i (1+ i)))) (if (insidep pt ent) (exit) (setq ent nil))))))) ent [color=Blue](command "._-bhatch" "_S" ent "" "")[/color] ) (simply added the ._-bhatch and made Test a subfunction, changed getpoint to accept a given point). Do you have any idea? regards Wolfgang Quote
Lee Mac Posted August 18, 2009 Posted August 18, 2009 Wolfgang, bear in mind that I made the test function so that it returned the value of ent whether it be nil or otherwise, so you will need to check for this. Quote
Lee Mac Posted August 18, 2009 Posted August 18, 2009 This should be more reliable for you - I forgot to disallow hatches in the selection set: (defun test (pt / i ss ent Obj) (vl-load-com) (if (and (setq i -1 ss (ssget "_X" (list (cons -4 "<NOT") (cons -4 "<OR") (cons 0 "HATCH") (cons 0 "VIEWPORT") (cons -4 "OR>") (cons -4 "NOT>"))))) (vl-catch-all-apply (function (lambda ( ) (while (setq ent (ssname ss (setq i (1+ i)))) (if (insidep pt ent) (exit) (setq ent nil))) (setq ent nil))))) (if ent (progn (and (vlax-property-available-p (setq Obj (vlax-ename->vla-object ent)) 'Closed) (not (vlax-put-property Obj 'Closed :vlax-true))) (setvar "HPNAME" "SOLID") (command "_.-bhatch" "_S" ent "" ""))) (princ)) Quote
wkplan Posted August 18, 2009 Author Posted August 18, 2009 Lee, I believe the hatch-filter made it. As I'm looking in my programm always for a point that is surrounded by a closed polyline, ent will never get nil. And therefore I can use ent as a parameter to the bhatch-command, no need to test or filter if the polyline is closed. I tried to put your code into my code, but got a error message "to few arguments". And so I changed your code as below, this works now perfect for my needs: (defun test (/ pt i ss ent) (vl-load-com) (if (and (setq pt p1) ; changed the getpoint-function, ; set pt=p1 which comes from an outer loop (setq i -1 ss (ssget "_X" (list (cons -4 "<NOT") (cons -4 "<OR") (cons 0 "HATCH") (cons 0 "INSERT") ; ingnore blocks too (cons 0 "VIEWPORT") (cons -4 "OR>") (cons -4 "NOT>"))))) (vl-catch-all-apply (function (lambda () (while (setq ent (ssname ss (setq i (1+ i)))) (if (insidep pt ent) (exit) (setq ent nil))))))) ent (progn (setvar "HPNAME" "SOLID") (command "._-bhatch" "_S" ent "" "") ; shortend the filter because I knew ent is closed ) ) I'm verry happy with this programm, have learned a lot, and I'm glad that you gave me such enormous support. I'd like to post the complete code here, but most of it is published at cadalyst's, where I took Raymond Rizkallah's code. Think I' better ask for permission. Kind regards Wolfgang Quote
VovKa Posted August 18, 2009 Posted August 18, 2009 (defun vk_IsPointInside (Point PointsList / PY P1Y P2Y) ; works with polygons only, i.e. if (equal (car PointsList) (last PointsList)) (if (cdr PointsList) (/= (and (or (and (<= (setq PY (cadr Point) P2Y (cadadr PointsList) P1Y (cadar PointsList) ) PY ) (< PY P2Y) ) (and (> P1Y PY) (>= PY P2Y)) ) (> (car Point) (+ (* (/ (- PY P1Y) (- P2Y P1Y)) (- (caadr PointsList) (caar PointsList)) ) (caar PointsList) ) ) ) (vk_IsPointInside Point (cdr PointsList)) ) ) ) Quote
Lee Mac Posted August 18, 2009 Posted August 18, 2009 Wolfgang, I changed the test function so that it accepts one argument - the point, if I were you, I would use the code I posted - there is a change that ent may be nil, and also my code will close any unclosed poly's Quote
Lee Mac Posted August 18, 2009 Posted August 18, 2009 > VovKa, I think there is something not quite right with yours Quote
VovKa Posted August 18, 2009 Posted August 18, 2009 Lee Mac, it seems ok for me. How did you test? 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.