Author Topic: help with routine Lee-Mac  (Read 2455 times)

0 Members and 1 Guest are viewing this topic.

TopoWAR

  • Newt
  • Posts: 135
help with routine Lee-Mac
« on: January 11, 2013, 04:17:36 PM »
Hi, I found navigating around this incredible routine teacher lee-mac, it works great, but I have a doubt in the dwg file I uploaded is a point that fails, or the point is within the routine but says this outside, maybe someone can tell me why? thanks

Code: [Select]
;; Point Inside-p  -  Lee Mac
;; Utilises a ray-casting algorithm to determine whether a
;; given point (WCS) resides within a supplied object.

(defun LM:PointInside-p ( pt obj / lst ray )
    (setq lst
        (vlax-invoke
            (setq ray
                (vla-addray
                    (vla-objectidtoobject (vla-get-document obj) (vla-get-ownerid obj))
                    (vlax-3D-point pt)
                    (vlax-3D-point (mapcar '+ pt '(1.0 0.0 0.0)))
                )
            )
            'intersectwith obj acextendnone
        )
    )
    (vla-delete ray)
    (= 1 (logand 1 (length lst)))
)

(defun c:test ( / ent obj pnt )
    (if (setq ent (car (entsel "\nSelect Polyline: ")))
        (if (vlax-method-applicable-p (setq obj (vlax-ename->vla-object ent)) 'intersectwith)
            (while (setq pnt (getpoint "\nPick Point: "))
                (if (LM:PointInside-p (trans pnt 1 0) obj)
                    (alert "Point is INSIDE")
                    (alert "Point is OUTSIDE")
                )
            )
            (princ "\nInvalid Object selected.")
        )
    )
    (princ)
)
(vl-load-com) (princ)

see attached dwg file
« Last Edit: January 11, 2013, 04:34:17 PM by TopoWAR »
Thanks for help

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: help with routine Lee-Mac
« Reply #1 on: January 12, 2013, 03:47:49 AM »
I don't know, but with my code it worked fine :

Code - Auto/Visual Lisp: [Select]
  1. (defun GroupByNum ( l n / f )
  2.   (defun f ( a b )
  3.     (if (and a (< 0 b))
  4.       (cons (car a) (f (setq l (cdr a)) (1- b)))
  5.     )
  6.   )
  7.   (if l (cons (f l n) (GroupByNum l n)))
  8. )
  9.  
  10. (defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
  11.   (setq vec12 (mapcar '- pt2 pt1))
  12.   (setq vec12 (reverse (cdr (reverse vec12))))
  13.   (setq vec1p (mapcar '- pt pt1))
  14.   (setq vec1p (reverse (cdr (reverse vec1p))))
  15.   (setq vec2p (mapcar '- pt2 pt))
  16.   (setq vec2p (reverse (cdr (reverse vec2p))))
  17.   (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
  18.   (if (equal d (+ d1 d2) 1e-8) (setq result T) (setq result nil))
  19.   result
  20. )
  21.  
  22. (defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
  23.   (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
  24.   (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
  25.   (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
  26.   (setq k 0)
  27.   (while (< (setq k (1+ k)) (length int))
  28.     (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
  29.   )
  30.   (setq tst (reverse tst))
  31.   (setq k 0)
  32.   (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
  33.   (vla-delete xlin)
  34.   (if kk
  35.     (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
  36.     (setq result nil)
  37.   )
  38.   result
  39. )
  40.  
  41. (defun c:test ( / pt ent )
  42.   (setq pt (getpoint "\nPick point : "))
  43.   (setq ent (car (entsel "\nPick closed 2D entity")))
  44.   (while (eq (cdr (assoc 70 (entget ent))) 0)
  45.     (prompt "\nPicked 2D entity is open, please pick closed one")
  46.     (setq ent (car (entsel "\nPick closed 2D entity")))
  47.   )
  48.   (if (ptinsideent pt ent) (alert "\nPoint is inside 2D closed entity") (alert "\nPoint is outside 2D closed entity"))
  49. )
  50.  

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: help with routine Lee-Mac
« Reply #2 on: January 12, 2013, 04:17:34 AM »
Here, I've modified Lee's code according to mine... The problem was in second point for creating ray (your polyline had one vertex extremely near point of intersection of ray, so intersectwith method calculated 2 points instead of one)... I used for second point of ray to find (vlax-curve-getclosestpointto ent pt) so now if doesn't make mistake...

Code: [Select]
;; Point Inside-p  -  Lee Mac
;; Utilises a ray-casting algorithm to determine whether a
;; given point (WCS) resides within a supplied object.

(defun LM:PointInside-p ( pt obj / lst ray )
    (setq lst
        (vlax-invoke
            (setq ray
                (vla-addray
                    (vla-objectidtoobject (vla-get-document obj) (vla-get-ownerid obj))
                    (vlax-3D-point pt)
                    (vlax-3D-point (vlax-curve-getclosestpointto obj pt))
                )
            )
            'intersectwith obj acextendnone
        )
    )
    (vla-delete ray)
    (= 1 (logand 1 (length lst)))
)

(defun c:test ( / ent obj pnt )
    (if (setq ent (car (entsel "\nSelect Polyline: ")))
        (if (vlax-method-applicable-p (setq obj (vlax-ename->vla-object ent)) 'intersectwith)
            (while (setq pnt (getpoint "\nPick Point: "))
                (if (LM:PointInside-p (trans pnt 1 0) obj)
                    (alert "Point is INSIDE")
                    (alert "Point is OUTSIDE")
                )
            )
            (princ "\nInvalid Object selected.")
        )
    )
    (princ)
)
(vl-load-com) (princ)

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

TopoWAR

  • Newt
  • Posts: 135
Re: help with routine Lee-Mac
« Reply #3 on: January 12, 2013, 12:12:55 PM »
ribarm ,
I appreciate the help, read routine solves the problem with point (vlax-3D-point (vlax-curve-getclosestpointto obj pt)) but fails worse, if your picks a point anywhere on the polyline produces a error, both in your code like Lee. would have to find another solution.
Thanks for help

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: help with routine Lee-Mac
« Reply #4 on: January 12, 2013, 01:54:45 PM »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: help with routine Lee-Mac
« Reply #5 on: January 12, 2013, 02:53:51 PM »
ribarm ,
I appreciate the help, read routine solves the problem with point (vlax-3D-point (vlax-curve-getclosestpointto obj pt)) but fails worse, if your picks a point anywhere on the polyline produces a error, both in your code like Lee. would have to find another solution.

You could use (vl-catch-all-apply) to catch error and if that's the case than you can comment it as point on curve...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

TopoWAR

  • Newt
  • Posts: 135
Re: help with routine Lee-Mac
« Reply #6 on: January 12, 2013, 03:11:23 PM »
ribarm , That might be a good solution, so be it. thanks!! :lol:
Thanks for help