For function unit .
;;; SS:ClosedCurve:Pinp&CW?
;;; function ---- Get Given Point position with a closed curve ,
;;; and determin Curve is Clokwise ?
;;; Curve ---- A closed curve , Curve-type must be "LWPOLYLINE" "CIRCLE" "ELLIPSE" "SPLINE" ;
;;; pt ---- a given point (in wcs)
;;; return a list (point_postion_num Clokwise_boolean)
;;; point_postion_num ---- -1 pt out of curve
;;; ---- 0 pt at curve
;;; ---- 1 pt in curve
;;; Clokwise_boolean ---- NIL Counter-Clockwise
;;; ---- T Clokwise
;;; by GSLS(SS) 2012-8-2
(defun SS:ClosedCurve:Pinp&CW? (curve pt / p l n r)
(if (vlax-curve-isclosed curve)
(progn
(setq l (get_closed_curve_pts curve))
(if (equal (setq p (vlax-curve-getclosestpointto en pt))
pt
1e-6
)
(progn
(setq n (get-widding-number
l
(polar p
(- (angle (list 0 0 0)
(vlax-curve-getfirstderiv
en
(vlax-curve-getparamatpoint
en
p
)
)
)
(* 0.5 pi)
)
0.1
)
)
)
(if (< n 0)
(list 0 T)
(list 0 NIL)
)
)
(progn
(setq n (get-widding-number l pt))
(if (< n 0)
(setq r (list T))
(setq r (list NIL))
)
(if (equal (fix n) n 1e-4)
(setq n (fix n))
(if (and (> n 0) (equal (1+ (fix n)) n 1e-4))
(setq n (1+ (fix n)))
(if (and (< n 0) (equal (1- (fix n)) n 1e-4))
(setq n (1- (fix n)))
(setq n (fix n))
)
)
)
(if (= (rem n 2) 0)
(cons -1 r)
(cons 1 r)
)
)
)
)
)
)
;;;---------------------
;;
(defun ss-assoc (a lst / b res)
(while (setq b (assoc a lst))
(setq lst (cdr (member b lst))
res (cons (cdr b) res)
))(reverse res))
;;
(defun acos (a)
(if (and (= (numberp a) T)
(<= (abs a) 1.0)
)
(if (= a 0.0)
(* pi 0.5)
(atan (/ (sqrt (- 1 (* a a)))
a
)
)
)
)
)
;; get point set of a closed curve by order
;; this function you improve by yourself acordding your need .
(defun get_closed_curve_pts (en / ent et)
;;by GSLS(SS)
(setq
ent (entget en)
et (cdr (assoc 0 ent))
)
(cond
((= et "LWPOLYLINE")
((lambda (/ a b vetex bu p1 p2 l r ang an1 N)
(while (setq ent (member (assoc 10 ent) ent))
(setq b (cons (cdar ent) b)
ent (member (assoc 42 ent) ent)
b (cons (cdar ent) b)
ent (cdr ent)
vetex (cons b vetex)
b nil
)
)
(while vetex
(setq a (car vetex)
vetex (cdr vetex)
bu (car a)
p1 (cadr a)
)
(if l
(setq p2 (car l))
(setq p2 (cadr (last vetex))
l (cons p2 l)
)
)
(if (equal bu 0 1e-6)
(setq l (cons p1 l))
(progn
(setq ang (* 2 (atan bu))
r (/ (distance p1 p2)
(* 2 (sin ang))
)
c (polar p1
(+ (angle p1 p2) (- (/ pi 2) ang))
r
)
r (abs r)
ang (abs (* ang 2.0))
N (abs (fix (/ ang 0.0174532925199433)))
)
(if (= N 0)
(setq l (cons p1 l))
(progn
(setq an1 (/ ang N)
ang (angle c p2)
)
(if (not (minusp bu))
(setq an1 (- an1))
)
(repeat (1- N)
(setq ang (+ ang an1))
(setq l (cons (polar c ang r) l))
)
(setq l (cons p1 l))
)
)
)
)
)
l
)
)
)
((= et "CIRCLE")
((lambda (c R / sa ptl)
(setq sa 0.0)
(repeat 180
(setq ptl (cons (polar c sa R) ptl)
sa (+ sa 0.0174532925199433)
)
)
(setq ptl (reverse ptl))
(append
ptl
(mapcar (function
(lambda (p)
(mapcar (function +) c (mapcar (function -) c p))
)
)
ptl
)
)
)
(cdr (assoc 10 ent))
(cdr (assoc 40 ent))
)
)
((= et "SPLINE")
((lambda (/ r l _oce)
(setq _oce (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(if (vl-catch-all-apply
(function vl-cmdf)
(list "_PEDIT"
(vlax-vla-object->ename
(vla-copy (vlax-ename->vla-object en))
)
""
10
""
)
)
(progn
(setq l (ss-assoc 10 (entget (setq r (entlast)))))
(if (vlax-curve-isClosed r)
(setq l (append l (list (car l))))
)
(entdel r)
)
)
(setvar "CMDECHO" _oce)
l
)
)
)
((= et "ELLIPSE")
((lambda (/ e l _os)
(setq _os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(vl-catch-all-apply
(function vla-offset)
(list (vlax-ename->vla-object en) 0.1)
)
(setq e (entlast))
(vl-catch-all-apply
(function vla-offset)
(list (vlax-ename->vla-object (entlast)) -0.1)
)
(entdel e)
(setq e (entlast))
(setq l (ss-assoc 10 (entget e)))
(entdel e)
(setvar "OSMODE" _os)
l
)
)
)
)
)
;;
;; This method suggest by Lee Mac from http://en.wikipedia.org/wiki/Winding_number
;; function : get widding number
;; l ---- point set of a Closed Curve
;; pt ---- a given point to determin position with the Closed Curve
;; return a widding number
;; by GSLS(SS) 2012-08-02
(defun get-widding-number (l pt / ang p1 p2)
(if (equal (car l) (last l) 1e-6)
nil
(setq l (append l (list (car l))))
)
(setq ang 0.0)
(while (cadr l)
(setq p1 (car l)
p2 (cadr l)
l (cdr l)
)
(if (equal p1 p2)
(setq an1 0.0)
(setq an1
((lambda (/ a b c d e f g)
(setq b (distance p1 pt)
c (distance p2 pt)
a (distance p1 p2)
d (- (* (- (car p1) (car pt)) (- (cadr p2) (cadr pt)))
(* (- (car p2) (car pt)) (- (cadr p1) (cadr pt)))
)
e (+ (* b b) (* c c) (* -1 a a))
f (abs (acos (/ e 2. b c)));_here must be Positive
g (/ d (abs d))
)
(if (< e 0)
(* g (- pi f))
(* g f)
)
)
)
)
)
(setq ang (+ ang an1))
)
(/ ang 2. pi)
)
Test function
(defun c:test (/ en pt n)
(setq en (car (entsel "\n Select a Closed Curve :")))
(while (setq pt (getpoint "\nSelect a point :"))
(setq n (SS:ClosedCurve:Pinp&CW? en pt))
(cond ((and (< (car n) 0) (cadr n))
(alert "Out , CW")
)
((and (< (car n) 0) (not (cadr n)))
(alert "Out , CCW")
)
((and (= (car n) 0) (cadr n))
(alert "At , CW")
)
((and (= (car n) 0) (not (cadr n)))
(alert "At , CCW")
)
((and (> (car n) 0) (cadr n))
(alert "In , CW")
)
((and (> (car n) 0) (not (cadr n)))
(alert "In , CCW")
)
)
)
(princ)
)
