;; Convex Hull - Lee Mac
;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
(defun LM:ConvexHull ( lst / ch p0 )
(cond
( (< (length lst) 4) lst)
( (setq p0 (car lst))
(foreach p1 (cdr lst)
(if (or (< (cadr p1) (cadr p0))
(and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
)
(setq p0 p1)
)
)
(setq lst (vl-remove p0 lst))
(setq lst (append (list p0) lst))
(setq lst
(vl-sort lst
(function
(lambda ( a b / c d )
(if (or (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (and (or (equal c 0.0 1e-8) (equal c (* 2 pi) 1e-8)) (or (equal d 0.0 1e-8) (equal d (* 2 pi) 1e-8))))
(< (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))
(< c d)
)
)
)
)
)
(setq ch (list (cadr lst) (car lst)))
(foreach pt (cddr lst)
(setq ch (cons pt ch))
(while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
(setq ch (cons pt (cddr ch)))
)
)
(reverse ch)
)
)
)
;; Clockwise-p - Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented or collinear
(defun LM:Clockwise-p ( p1 p2 p3 )
(< (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
)
1e-8
)
)
(defun c:chull ( / i l s )
(if (setq s (ssget '((0 . "POINT"))))
(progn
(repeat (setq i (sslength s))
(setq l (cons (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))) l))
)
(setq l (LM:ConvexHull l))
(entmakex
(append
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length l))
'(070 . 1)
)
(mapcar '(lambda ( x ) (cons 10 x)) l)
)
)
)
)
(princ)
)
(defun c:test_pi (/ p l)
(if (setq p (getpoint "\nPick 1st point: "))
(progn (setq p (trans p 1 0)
l (list p)
)
(while (setq p (getpoint "\nPick next point <Exit>: "))
(setq p (trans p 1 0)
l (cons p l)
)
)
)
)
(setq p (getpoint "\nPick point to verify: "))
(if (inside_p p l) (print "Point inside or collinear"))
(princ)
)
(defun inside_p (:p :Lst / Fp cross on)
(setq Fp (mapcar '+ '(1.0 1.0 0.0) (getvar 'extmax)))
(setq cross 0)
(if (not (member :p :Lst))
(mapcar
'(lambda (a b)
(if (inters :p Fp a b) (setq cross (1+ cross)))
(if (equal (+ (distance :p a) (distance :p b)) (distance a b) 1e-8) (setq on t))
)
(cons (last :Lst) :Lst) :Lst
)
(setq on t)
)
(or (not (zerop (rem cross 2))) on)
)