Halsy Posted March 26 Share Posted March 26 (edited) Hello, Need help to resolve mention problem, this routing used for to check point inside of polygon (defun pt-in-region (pt pts Acc / ss-member-pts pt1 ptn p at) ;;judge a point is in the 2D polygon , polygon given with vetexs . ;;by GSLS(SS) 2011.03.28 ;;return 0 at polygon, 1 in it, -1 out it . (defun ss-member-pts (pt ptl acc / is_go i len a b) (setq is_go T i 0 len(length ptl)) (while (and is_go (< i len)) (setq a(car ptl)ptl(cdr ptl)i(1+ i)) (if (and a (equal a pt acc)) (setq is_go nil b (cons a ptl))))) (setq pt1(list (+ (car (apply (function mapcar) (cons (function max) pts)))(abs acc)(abs acc))(cadr pt))) (mapcar(function(lambda (x y) (if(setq p (inters pt pt1 x y T)) (progn (if(equal (+(distance pt x)(distance pt y))(distance x y)acc)(setq at T)) (if(not (ss-member-pts p pts acc)) (setq ptn (cons p ptn))))))) (cons (last pts) pts) pts) (cond (at 0) ((and (not at) ptn) (if (= (rem (length ptn) 2) 1) 1 -1 )) (t -1) ) ) ;;pts pt is (defun c:test (/ ss-assoc ) (defun ss-assoc (a lst / b lst2) (while (setq b (assoc a lst)) (setq lst (cdr (member b lst)) lst2 (cons (cdr b) lst2) )) (reverse lst2) ) (setq pt (getpoint) p2 (polar pt 0 10000) poly (ssname (ssget "f" (list pt p2) '((0 . "LWPOLYLINE"))) 0) pts (ss-assoc 10 (entget (car poly))) ) (setq is (pt-in-region pt pts 1e-8)) (cond ((= is -1) (alert "Out .")) ((= is 0) (alert "At .")) ((= is 1) (alert "In .")) ) (princ) ) Edited March 26 by Halsy Quote Link to comment Share on other sites More sharing options...
Steven P Posted March 26 Share Posted March 26 without checking fully it could be this line: pts (ss-assoc 10 (entget (car poly))) remove the '(car poly)' to be just poly Quote Link to comment Share on other sites More sharing options...
Halsy Posted March 26 Author Share Posted March 26 (defun c:test (/ ss-assoc ) (defun ss-assoc (a lst / b lst2) (while (setq b (assoc a lst)) (setq lst (cdr (member b lst)) lst2 (cons (cdr b) lst2) )) (reverse lst2) ) (setq pt (getpoint) p2 (polar pt 0 10000) poly (ssname (ssget "f" (list pt p2) '((0 . "LWPOLYLINE"))) 0) pts (ss-assoc 10 (entget poly)) ) (if (/= pts nil) (progn (setq is (pt-in-region pt pts 1e-8)) (cond ((= is -1) (alert "Out .")) ((= is 0) (alert "At .")) ((= is 1) (alert "In .")) ) ) (progn (alert "please select inside of polygaon:") ) );end of if (princ) ) if user select out side of polygon, error occurs what i have to do trap error Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted March 26 Share Posted March 26 (edited) It's more in how the code has been written. You've set p2 to be the polar of pt at 0 degrees. So if there's no curve along that direction, ssget cannot find any curve and returns nil, thus ssname then yields an error. I would do it this way: (defun pt-in-region (pt pts Acc / ss-member-pts pt1 ptn p at ACC AT P PT PT1 PTN PTS) ;;judge a point is in the 2D polygon , polygon given with vetexs . ;;by GSLS(SS) 2011.03.28 ;;return 0 at polygon, 1 in it, -1 out it . (defun ss-member-pts (pt ptl acc / is_go i len a b) (setq is_go T i 0 len(length ptl)) (while (and is_go (< i len)) (setq a(car ptl)ptl(cdr ptl)i(1+ i)) (if (and a (equal a pt acc)) (setq is_go nil b (cons a ptl))))) (setq pt1(list (+ (car (apply (function mapcar) (cons (function max) pts)))(abs acc)(abs acc))(cadr pt))) (mapcar(function(lambda (x y) (if(setq p (inters pt pt1 x y T)) (progn (if(equal (+(distance pt x)(distance pt y))(distance x y)acc)(setq at T)) (if(not (ss-member-pts p pts acc)) (setq ptn (cons p ptn))))))) (cons (last pts) pts) pts) (cond (at 0) ((and (not at) ptn) (if (= (rem (length ptn) 2) 1) 1 -1 )) (t -1) ) ) ;;pts pt is (defun c:test (/ is poly pt pts) (setq pt (getpoint) poly (ssget "f" (list pt (polar pt 0 10000)) '((0 . "LWPOLYLINE"))) ) (cond ((not poly) (alert "Out .")) (t (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname poly 0)) ) ) is (pt-in-region pt pts 1e-8) ) (cond ((= is -1) (alert "Out .")) ((= is 0) (alert "At .")) ((= is 1) (alert "In .")) ) ) ) (princ) ) That being said, your code still yields incorrect results sometimes... That's if there is a horizontal segment along the polyline? I guess it's just up to the function itself: Edited March 26 by Jonathan Handojo 1 Quote Link to comment Share on other sites More sharing options...
mhupp Posted March 27 Share Posted March 27 (edited) Edited March 27 by mhupp Quote Link to comment Share on other sites More sharing options...
Halsy Posted March 27 Author Share Posted March 27 (vl-load-com) (defun getcoords (ent) (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) "Coordinates" ) ) ) ) (defun co-ords2xy () ; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z (setq numb (/ (length co-ords) 2)) (setq I 0) (repeat numb (setq xy (list (nth I co-ords)(nth (+ I 1) co-ords) )) (setq coordsxy (cons xy coordsxy)) (setq I (+ I 2)) ) ; end repeat ) ; end defun ; (defun c:test (/ is poly pt pts) (setq pt (getpoint) poly (ssget "f" (list pt (polar pt 0 10000)) '((0 . "LWPOLYLINE") (-4 . "<or")(8 . "MO-UPSTAND")(8 . "MO-BEAM")(8 . "MO-WALL")(-4 . "or>"))) ) (cond ((not poly) (alert "Out .")) (t (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname poly 0)) ) ) is (pt-in-region pt pts 1e-8) ) (cond ((= is -1) (alert "Out .")) ((= is 0) (setq co-ords (getcoords (ssname poly 0))) (co-ords2xy) ; write pline co-ords here (setq ss (ssget "WP" coordsxy '((0 . "text") (-4 . "<or")(8 . "MO-UPSTAND")(8 . "MO-BEAM")(8 . "MO-WALL")(-4 . "or>")))) ; selection set of text within polygon (alert "At .")) ((= is 1) (setq co-ords (getcoords (ssname poly 0))) (co-ords2xy) ; write pline co-ords here (setq ss (ssget "WP" coordsxy '((0 . "text") (-4 . "<or")(8 . "MO-UPSTAND")(8 . "MO-BEAM")(8 . "MO-WALL")(-4 . "or>")))) ; selection set of text within polygon (alert "In .")) ) ) ) (princ) ) try to extract text from closed polygaon but it turn ss nil. whats wrong with my code . demo.dwg Quote Link to comment Share on other sites More sharing options...
Halsy Posted March 27 Author Share Posted March 27 7 hours ago, Jonathan Handojo said: It's more in how the code has been written. You've set p2 to be the polar of pt at 0 degrees. So if there's no curve along that direction, ssget cannot find any curve and returns nil, thus ssname then yields an error. I would do it this way: (defun pt-in-region (pt pts Acc / ss-member-pts pt1 ptn p at ACC AT P PT PT1 PTN PTS) ;;judge a point is in the 2D polygon , polygon given with vetexs . ;;by GSLS(SS) 2011.03.28 ;;return 0 at polygon, 1 in it, -1 out it . (defun ss-member-pts (pt ptl acc / is_go i len a b) (setq is_go T i 0 len(length ptl)) (while (and is_go (< i len)) (setq a(car ptl)ptl(cdr ptl)i(1+ i)) (if (and a (equal a pt acc)) (setq is_go nil b (cons a ptl))))) (setq pt1(list (+ (car (apply (function mapcar) (cons (function max) pts)))(abs acc)(abs acc))(cadr pt))) (mapcar(function(lambda (x y) (if(setq p (inters pt pt1 x y T)) (progn (if(equal (+(distance pt x)(distance pt y))(distance x y)acc)(setq at T)) (if(not (ss-member-pts p pts acc)) (setq ptn (cons p ptn))))))) (cons (last pts) pts) pts) (cond (at 0) ((and (not at) ptn) (if (= (rem (length ptn) 2) 1) 1 -1 )) (t -1) ) ) ;;pts pt is (defun c:test (/ is poly pt pts) (setq pt (getpoint) poly (ssget "f" (list pt (polar pt 0 10000)) '((0 . "LWPOLYLINE"))) ) (cond ((not poly) (alert "Out .")) (t (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname poly 0)) ) ) is (pt-in-region pt pts 1e-8) ) (cond ((= is -1) (alert "Out .")) ((= is 0) (alert "At .")) ((= is 1) (alert "In .")) ) ) ) (princ) ) That being said, your code still yields incorrect results sometimes... That's if there is a horizontal segment along the polyline? I guess it's just up to the function itself: (defun c:test (/ ss-assoc ) (defun ss-assoc (a lst / b lst2) (while (setq b (assoc a lst)) (setq lst (cdr (member b lst)) lst2 (cons (cdr b) lst2) )) (reverse lst2) ) (setq pt (getpoint) p2 (polar pt 0 10000) poly (ssget "f" (list pt p2) '((0 . "LWPOLYLINE") (-4 . "<or")(8 . "MO-UPSTAND")(8 . "MO-BEAM")(8 . "MO-WALL")(-4 . "or>"))) ) (if (/= poly nil) (progn (setq pts (ss-assoc 10 (entget (ssname poly 0))) is (pt-in-region pt pts 1e-8) poly1 (ssname poly 0) ) (cond ((= is -1) (alert "Out .")) ((= is 0) (setq co-ords (getcoords poly1)) (co-ords2xy) ; write pline co-ords here (setq ss (ssget "WP" coordsxy (list (cons 0 "Text,Mtext")))) ; selection set of text within polygon (alert "At .")) ((= is 1) (setq co-ords (getcoords poly1)) (co-ords2xy) ; write pline co-ords here (setq ss (ssget "WP" coordsxy '((0 . "text") (-4 . "<or")(8 . "MO-UPSTAND")(8 . "MO-BEAM")(8 . "MO-WALL")(-4 . "or>")))) ; selection set of text within polygon (alert "In .")) ) ) (progn (alert "please select inside of polygaon:") ) );end of if (princ) ) this is my code is it right Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted March 27 Share Posted March 27 No, your code isn't quite right. Also, setting your variable like how you did from another function isn't really a good practice. I would approach it this way: (defun getcoords (ent) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent) ) ) ) (defun c:test (/ is lay poly pt pts) (setq pt (getpoint) lay '((-4 . "<or")(8 . "MO`-UPSTAND")(8 . "MO`-BEAM")(8 . "MO`-WALL")(-4 . "or>")) poly (ssget "f" (list pt (polar pt 0 10000)) (append '((0 . "LWPOLYLINE")) lay)) ) (cond ( (not poly) (alert "Out .")) ( t (setq pts (getcoords (ssname poly 0)) is (pt-in-region pt pts 1e-8) ) (cond ( (= is -1) (alert "Out .")) ( (= is 0) (setq ss (ssget "WP" pts (append '((0 . "text")) lay))) ; selection set of text within polygon (alert "At .") ) ( (= is 1) (setq ss (ssget "WP" pts (append '((0 . "text")) lay))) ; selection set of text within polygon (alert "In .") ) ) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Steven P Posted March 28 Share Posted March 28 Vaguely remember doing something like this before. If you are able to make a hatch then your selected point is inside an area. If you can't then you are outside. Note that this returns a report that boundary associativity removed if a hatch was able to be created - nothing to worry about here. Little bit crude perhaps - if the point selected is inside any boundary it will return saying inside, 4 lines, a circle, anything. There is some useful stuff that you can set the gap distance (below set to 5) rather then rely on closed polylines (defun c:test ( / MyEntLast pt ) (setq MyEntLast (entlast)) (setq pt (getpoint "GetPoint")) (command "-hatch" "a" "g" 5 "" pt "") ;;"g" 5 to set gap distance for opened polylines. Adjust to suit (setq MyHatch (entlast)) (if (equal MyHatch MyEntLast) (setq Result "\nNo Hatch, outside of an area") (progn (command "erase" (entlast) "") (setq result "Inside an area") ) ) ; end if (princ result) (princ) ) Quote Link to comment Share on other sites More sharing options...
mhupp Posted March 29 Share Posted March 29 2 hours ago, Steven P said: If you are able to make a hatch then your selected point is inside an area. If you can't then you are outside. I was thinking of doing the same thing but with bpoly. Only problem it could give false positives if the point is outside the original polyline but still inside another closed polyline or area. 1 Quote Link to comment Share on other sites More sharing options...
Steven P Posted March 29 Share Posted March 29 That would work I think. Not sure how you'd get away from false positives without selecting the polyline as well I had another option before which was offset the polyline and test a few points along it to show whether the point is closer or further away than the corresponding point on the original and offset line, a sum of all vertex distances for each line, smaller result is inside, larger result is outside I think... but didn't get time to make that one up Quote Link to comment Share on other sites More sharing options...
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.