I was faced with similar challenges.ElpanovEvgeniy,thank you!
At various times I used the three algorithms
1. analysis of the geometry of the bounding segments (perpendicular, the centers of arcs, etc).
2. approximation of the internal space of the pixels and finding the greatest area filled with pixels.
3. method of inflating the bubble.
was the most efficient region filling in squares, and further analysis of the internal squares as pixels, as points.
ElpanovEvgeniy,thank you!
ElpanovEvgeniy,thank you!
thanks for that I will not participate in the contest...
Do I understand correctly? :-D :-D :-D
;;; maximum circle inscribed in a closed polyline
;;; Gian Paolo Cattaneo
(defun C:TesT (/ POLY POLY_vl Dx Dy Lp List_vert_poly list_p_int P_center dist step1 step2)
(prompt "\nSelect Polyline: ")
(if (setq POLY (ssname (ssget ":S" '((0 . "LWPOLYLINE"))) 0))
(progn
(setq i 1 timer (date2sec))
(setq step1 60) ;--> grid_1
(setq step2 20) ;--> grid_2
(setq POLY_vl (vlax-ename->vla-object POLY))
(setq list_vert_poly (LM:LWPoly->List POLY))
(grid_1)
(Point_int)
(grid+)
(Point_center)
(repeat 3
(grid_2)
(Point_center)
)
(entmake
(list
(cons 0 "CIRCLE")
(cons 8 (getvar "clayer"))
(cons 10 P_center)
(cons 40 dist)
)
)
(setq endtimer (date2sec))
(princ (strcat "time = "(rtos (- endtimer timer) 2 3) " seconds"))
(princ)
)
)
)
;; LWPolyline to Point List - Lee Mac
;; Returns a list of points describing the supplied LWPolyline
(defun LM:LWPoly->List ( ent / der di1 di2 inc lst par rad )
(setq par 0)
(repeat (cdr (assoc 90 (entget ent)))
(if (setq der (vlax-curve-getsecondderiv ent par))
(if (equal der '(0.0 0.0 0.0) 1e-8)
(setq lst (cons (vlax-curve-getpointatparam ent par) lst))
(if
(setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
di1 (vlax-curve-getdistatparam ent par)
di2 (vlax-curve-getdistatparam ent (1+ par))
)
(progn
(setq inc (/ (- di2 di1) (1+ (fix (* 25 (/ (- di2 di1) rad (+ pi pi)))))))
(while (< di1 di2)
(setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
di1 (+ di1 inc)
)
)
)
)
)
)
(setq par (1+ par))
)
lst
)
; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata
; Returns a grid of points within the BoundingBox of the selected poly
(defun grid_1 (/ P1_ P2_ n P> )
(vla-getboundingbox POLY_vl 'p1 'p2)
(setq P1_ (vlax-safearray->list p1))
(setq P2_ (vlax-safearray->list p2))
(setq P1_ (list (car P1_) (cadr P1_)))
(setq P2_ (list (car P2_) (cadr P2_)))
(setq Dx (/ (- (car P2_) (car P1_)) step1))
(setq Dy (/ (- (cadr P2_) (cadr P1_)) step1))
(setq n 0)
(setq P> P1_)
(setq Lp (list P1_))
(repeat (* (1+ step1) step1)
(setq P> (list (+ (car P>) Dx) (cadr P>)))
(setq Lp (cons P> Lp))
(setq n (1+ n))
(if (= n step1)
(progn
(setq n 0)
(setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
(setq P> P1_)
(setq Lp (cons P> Lp))
)
)
)
(setq Lp (cdr Lp))
)
; Restituisce una griglia di punti intorno al punto centrale (provvisorio)
; Returns a grid of points around the center point (provisional)
(defun grid_2 (/ P1_ P> n)
(setq list_p_int nil)
(setq P1_ (list (- (car P_center) (* Dx 2)) (- (cadr P_center) (* Dy 2))))
(setq Dx (/ (* 4 Dx) step2))
(setq Dy (/ (* 4 Dy) step2))
(setq n 0)
(setq P> P1_)
(setq list_p_int (list P1_))
(repeat (* (1+ step2) step2)
(setq P> (list (+ (car P>) Dx) (cadr P>)))
(setq list_p_int (cons P> list_p_int))
(setq n (1+ n))
(if (= n step2)
(progn
(setq n 0)
(setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
(setq P> P1_)
(setq list_p_int (cons P> list_p_int))
)
)
)
)
; restituisce la lista dei punti interni ad un poligono
; dati: - lista coordinate dei punti -> Lp
; - lista coordinate vertici poligono -> list_vert_poly
; Returns the list of points inside the polyline
(defun Point_int (/ P_distant n Pr cont attr p# Pa Pa_ Pb )
(setq P_distant (list (car (getvar "extmax")) (* 2 (cadr (getvar "extmax")))))
(setq list_p_int nil)
(foreach Pr Lp
(setq cont -1)
(setq attr 0)
(setq p# nil)
(setq Pa (nth (setq cont (1+ cont)) list_vert_poly))
(setq Pa_ Pa)
(repeat (length list_vert_poly)
(setq Pb (nth (setq cont (1+ cont)) list_vert_poly))
(if (= cont (length list_vert_poly)) (setq Pb Pa_))
(setq P# (inters Pa Pb Pr P_distant))
(if (/= P# nil) (setq attr (1+ attr)))
(setq Pa Pb)
)
(if (> (rem attr 2) 0) (setq list_p_int (cons Pr list_p_int)))
)
)
; Infittisce la griglia inserendo altri punti
; nel centro delle diagonali tra i punti interni
; Insert points (interior) to increase the density of the grid
(defun grid+ (/ G+)
(setq G+
(mapcar '(lambda ( x ) (list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))) list_p_int)
)
(setq list_p_int (append G+ list_p_int))
)
; Da una lista di punti restituisce quello pił lontano da un oggetto
; dati: - lista dei punti -> list_p_int
; - oggetto -> POLY_vl
; Returns the farthest point from the polyline
(defun Point_center (/ Pa n Pvic)
(setq Dist 0.0000001)
(setq P_center nil)
(foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo POLY_vl Pa))
(if (> (distance Pa Pvic) Dist)
(progn
(setq P_center Pa)
(setq Dist (distance Pa Pvic))
)
)
)
)
(defun date2sec ()
(setq s (getvar "DATE"))
(setq seconds (* 86400.0 (- s (fix s))))
)
(vl-load-com)
(princ)
You can approximate? :-)Code: [Select]...
You can approximate? :-)
1 2 1
2 3 4 3 2
1 3 4 5 4 3 1
2 4 5 6 5 4 2
1 3 4 5 4 3 1
2 3 4 3 2
1 2 1
example of the brush:
You can approximate? :-)Great routine !Code: [Select];;; maximum circle inscribed in a closed polyline
;;; Gian Paolo Cattaneo
(defun C:TesT (/ POLY POLY_vl Dx Dy Lp List_vert_poly list_p_int P_center dist step1 step2)
(prompt "\nSelect Polyline: ")
(if (setq POLY (ssname (ssget ":S" '((0 . "LWPOLYLINE"))) 0))
(progn
(setq i 1 timer (date2sec))
(setq step1 60) ;--> grid_1
(setq step2 20) ;--> grid_2
(setq POLY_vl (vlax-ename->vla-object POLY))
(setq list_vert_poly (LM:LWPoly->List POLY))
(grid_1)
(Point_int)
(grid+)
(Point_center)
(repeat 3
(grid_2)
(Point_center)
)
(entmake
(list
(cons 0 "CIRCLE")
(cons 8 (getvar "clayer"))
(cons 10 P_center)
(cons 40 dist)
)
)
(setq endtimer (date2sec))
(princ (strcat "time = "(rtos (- endtimer timer) 2 3) " seconds"))
(princ)
)
)
)
;; LWPolyline to Point List - Lee Mac
;; Returns a list of points describing the supplied LWPolyline
(defun LM:LWPoly->List ( ent / der di1 di2 inc lst par rad )
(setq par 0)
(repeat (cdr (assoc 90 (entget ent)))
(if (setq der (vlax-curve-getsecondderiv ent par))
(if (equal der '(0.0 0.0 0.0) 1e-8)
(setq lst (cons (vlax-curve-getpointatparam ent par) lst))
(if
(setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
di1 (vlax-curve-getdistatparam ent par)
di2 (vlax-curve-getdistatparam ent (1+ par))
)
(progn
(setq inc (/ (- di2 di1) (1+ (fix (* 25 (/ (- di2 di1) rad (+ pi pi)))))))
(while (< di1 di2)
(setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
di1 (+ di1 inc)
)
)
)
)
)
)
(setq par (1+ par))
)
lst
)
; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata
; Returns a grid of points within the BoundingBox of the selected poly
(defun grid_1 (/ P1_ P2_ n P> )
(vla-getboundingbox POLY_vl 'p1 'p2)
(setq P1_ (vlax-safearray->list p1))
(setq P2_ (vlax-safearray->list p2))
(setq P1_ (list (car P1_) (cadr P1_)))
(setq P2_ (list (car P2_) (cadr P2_)))
(setq Dx (/ (- (car P2_) (car P1_)) step1))
(setq Dy (/ (- (cadr P2_) (cadr P1_)) step1))
(setq n 0)
(setq P> P1_)
(setq Lp (list P1_))
(repeat (* (1+ step1) step1)
(setq P> (list (+ (car P>) Dx) (cadr P>)))
(setq Lp (cons P> Lp))
(setq n (1+ n))
(if (= n step1)
(progn
(setq n 0)
(setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
(setq P> P1_)
(setq Lp (cons P> Lp))
)
)
)
(setq Lp (cdr Lp))
)
; Restituisce una griglia di punti intorno al punto centrale (provvisorio)
; Returns a grid of points around the center point (provisional)
(defun grid_2 (/ P1_ P> n)
(setq list_p_int nil)
(setq P1_ (list (- (car P_center) (* Dx 2)) (- (cadr P_center) (* Dy 2))))
(setq Dx (/ (* 4 Dx) step2))
(setq Dy (/ (* 4 Dy) step2))
(setq n 0)
(setq P> P1_)
(setq list_p_int (list P1_))
(repeat (* (1+ step2) step2)
(setq P> (list (+ (car P>) Dx) (cadr P>)))
(setq list_p_int (cons P> list_p_int))
(setq n (1+ n))
(if (= n step2)
(progn
(setq n 0)
(setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
(setq P> P1_)
(setq list_p_int (cons P> list_p_int))
)
)
)
)
; restituisce la lista dei punti interni ad un poligono
; dati: - lista coordinate dei punti -> Lp
; - lista coordinate vertici poligono -> list_vert_poly
; Returns the list of points inside the polyline
(defun Point_int (/ P_distant n Pr cont attr p# Pa Pa_ Pb )
(setq P_distant (list (car (getvar "extmax")) (* 2 (cadr (getvar "extmax")))))
(setq list_p_int nil)
(foreach Pr Lp
(setq cont -1)
(setq attr 0)
(setq p# nil)
(setq Pa (nth (setq cont (1+ cont)) list_vert_poly))
(setq Pa_ Pa)
(repeat (length list_vert_poly)
(setq Pb (nth (setq cont (1+ cont)) list_vert_poly))
(if (= cont (length list_vert_poly)) (setq Pb Pa_))
(setq P# (inters Pa Pb Pr P_distant))
(if (/= P# nil) (setq attr (1+ attr)))
(setq Pa Pb)
)
(if (> (rem attr 2) 0) (setq list_p_int (cons Pr list_p_int)))
)
)
; Infittisce la griglia inserendo altri punti
; nel centro delle diagonali tra i punti interni
; Insert points (interior) to increase the density of the grid
(defun grid+ (/ G+)
(setq G+
(mapcar '(lambda ( x ) (list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))) list_p_int)
)
(setq list_p_int (append G+ list_p_int))
)
; Da una lista di punti restituisce quello pił lontano da un oggetto
; dati: - lista dei punti -> list_p_int
; - oggetto -> POLY_vl
; Returns the farthest point from the polyline
(defun Point_center (/ Pa n Pvic)
(setq Dist 0.0000001)
(setq P_center nil)
(foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo POLY_vl Pa))
(if (> (distance Pa Pvic) Dist)
(progn
(setq P_center Pa)
(setq Dist (distance Pa Pvic))
)
)
)
)
(defun date2sec ()
(setq s (getvar "DATE"))
(setq seconds (* 86400.0 (- s (fix s))))
)
(vl-load-com)
(princ)
...
Great routine !
May need higher accuracy ?
(repeat 3
(grid_2)
(Point_center)
)for(repeat 8
(grid_2)
(Point_center)
)
replaceThanks ElpanovEvgeniy.Code: [Select](repeat 3for
(grid_2)
(Point_center)
)Code: [Select](repeat 8
(grid_2)
(Point_center)
)
...
(progn
(setq i 1 t1 (getvar "MilliSecs"))
(setq step1 100) ;--> grid_1
(setq step2 40) ;--> grid_2
(setq POLY_vl (vlax-ename->vla-object POLY))
(setq list_vert_poly (LM:LWPoly->List POLY))
(grid_1)
(Point_int)
(grid+)
(Point_center)
(repeat 2
(grid_2)
(Point_center)
)
(entmake
(list
(cons 0 "CIRCLE")
(cons 10 P_center)
(cons 40 dist)
)
)
(setq t2 (getvar "MilliSecs"))
(princ (strcat "time = "(rtos (- t2 t1) 2 0) " MilliSecs"))
(princ)
)
...
Perhaps , When the grid division is not small enough in step1 , ALL close to the max-dia zone from step1 must be calculated in step2 ? 1 2 1
2 3 4 3 2
1 3 4 5 4 3 1
2 4 5 6 5 4 2
1 3 4 5 4 3 1
2 3 4 3 2
1 2 1 1 2 1
2 3 4 3 2
1 3 4 5 4 3 1
2 3 4 3 1
1 2 1
Code: [Select]1 2 1
2 3 4 3 2
1 3 4 5 4 3 1
2 4 5 6 5 4 2
1 3 4 5 4 3 1
2 3 4 3 2
1 2 1 1 2 1
2 3 4 3 2
1 3 4 5 4 3 1
2 3 4 3 1
1 2 1
Here we have:
1) It is obvious that circle is inside of the boundary.
2) Circle must touch the boundary in at least 2 places.
Perhaps , When the grid division is not small enough in step1 , ALL close to the max-dia zone from step1 must be calculated in step2 ?
...GP,Very good explanation,a lot of thanks.
ElpanovEvgeniy, Yes,your algorithm is amazing.
My oalgorithm can get a very accurate answer,but sometimes it doesn't work,and takes a lot of time.
I was told algorithm, more than 10 years ago.
He told me a very old wise man.
Ordered to make a shape out of plywood.
Sprinkle dry sand on plywood.
The top of the sand - the largest center of the inscribed circle.
Ridges of - the contour of the skeleton.
;max circle inside polyline
;Stefan M. 26.07.2012
(defun C:TEST ( / space e l m c o r p offtype)
(setq space (vlax-get (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= (getvar 'cvport) 1) 'PaperSpace 'ModelSpace)))
(setq offtype (getvar 'offsetgaptype))
(setvar 'offsetgaptype 1)
(if (setq e (ssget ":E:S:L" '((0 . "LWPOLYLINE"))))
(progn
(setq e (vlax-ename->vla-object (ssname e 0))
l (list (vla-copy e))
m 0.0
)
(while l
(foreach x l
(if
(setq c (cond ((and
(= (vlax-curve-GetEndParam x) 2.0)
(or
(vl-some 'zerop (mapcar '(lambda (a) (vla-getbulge x a)) '(0 1)))
(<=
(distance
(vlax-curve-GetPointAtParam x 0.5)
(vlax-curve-GetPointAtParam x 1.5)
)
(distance
(vlax-curve-GetPointAtParam x 0.0)
(vlax-curve-GetPointAtParam x 1.0)
)
)
)
)
(mapcar '(lambda (a b) (* 0.5 (+ a b)))
(vlax-curve-GetPointAtParam x 0.5)
(vlax-curve-GetPointAtParam x 1.5)
)
)
((and
(= (vlax-curve-GetEndParam x) 3.0)
(vlax-curve-IsClosed x)
(vl-every 'zerop (mapcar '(lambda (a) (vla-getbulge x a)) '(0 1 2)))
)
(incircle x)
)
((and
(= (vlax-curve-GetEndParam x) 4.0)
(equal '(0. 0. 0.) (mapcar '+ (vlax-curve-GetFirstDeriv x 0.5) (vlax-curve-GetFirstDeriv x 2.5)) 1e-8)
(equal '(0. 0. 0.) (mapcar '+ (vlax-curve-GetFirstDeriv x 1.5) (vlax-curve-GetFirstDeriv x 3.5)) 1e-8)
)
(median x)
)
((< (vla-get-area x) 1e-7) (median x))
)
)
(if
(equal (setq r (distance c (vlax-curve-GetClosestPointTo e c))) m 1e-8)
(setq p (cons (list c r) p))
(if (> r m) (setq p (list (list c r)) m r))
)
(setq o (append (offset_in x) o))
)
(vla-delete x)
)
(setq l o o nil)
)
(foreach x p (vla-put-Color (vla-AddCircle space (vlax-3D-point (car x)) (cadr x)) acRed))
)
)
(setvar 'offsetgaptype offtype)
(princ)
)
(defun incircle (e / a b c p pt)
(setq a (vlax-curve-GetDistAtParam e 1)
b (- (vlax-curve-GetDistAtParam e 2) a)
c (- (setq p (vlax-curve-GetDistAtParam e 3)) a b)
pt (mapcar 'vlax-curve-GetPointAtParam (list e e e) '(2 3 1))
)
(mapcar
'(lambda (x) (/ (apply '+ (mapcar '* (list a b c) x)) p))
(list
(mapcar 'car pt)
(mapcar 'cadr pt)
)
)
)
(defun median (e / i l n)
(repeat
(setq n (fix (setq i (vlax-curve-GetEndParam e))))
(setq l (cons (vlax-curve-GetPointAtParam e (setq n (1- n))) l))
)
(mapcar
'(lambda (x) (/ (apply '+ x) i))
(list
(mapcar 'car l)
(mapcar 'cadr l)
)
)
)
(defun offset_in (e / i)
(setq i (/ (vla-get-Area e) (vla-get-Length e) 10.0))
(apply
'append
(mapcar
(function
(lambda (x / o)
(if
(not (vl-catch-all-error-p (setq o (vl-catch-all-apply 'vlax-invoke (list e 'Offset x)))))
(vl-remove-if
'(lambda (a)
(and
(or
(> (vla-get-Area a) (vla-get-Area e))
(> (vla-get-Length a) (vla-get-Length e))
)
(not (vla-delete a))
)
)
o
)
)
)
)
(list i (- i))
)
)
)
Wonderful explanation, GP, Thank you very much.Perhaps , When the grid division is not small enough in step1 , ALL close to the max-dia zone from step1 must be calculated in step2 ?
Is very important to the value of (step1)
If there are areas of similar size could potentially contain the maximum circle, it is appropriate to increase this value, to the detriment of the time required.
Increasing the value of (repeat N (grid_2) (Point_center)) is then refined the position of point searched.
(grid_1) ---> subdivision = step1 x step1
(grid_2) ---> subdivision = step2 x step2
Stefan，Excellent!! 8-)1+
Both of you are geniuses!
matrix take shape and fill it with a brush matrixExcellent algorithm !
then add up the numbers and find the position of the greatest number.
matrix take shape and fill it with a brush matrixExcellent algorithm !
then add up the numbers and find the position of the greatest number.
Look forward to further implementation .
Does it has been used in the ?
Yes, I have used this algorithm in one of the commercial programs. I can not publish the code here, and details of use. But I have shown the way!Depth explanation of the grid method , Thanks again .
I think that these algorithms are not used in AutoCAD Core Applications, but can not be sure...In some old acad versions , I miss seen that boundary can be created by two method , one is Filling Method , another is Ray Method .
"Ray Method" is a method for determining the inside or the outside.Thanks ElpanovEvgeniy .
In their programs, I use another method to determine the inside or the outside. It does not require checking the intersection and running quickly.
need to check the direction of a polyline, the angle between the direction of the polyline and the first derivative. If 0 < A < pi and polyline counter-clockwise, the point is inside. If the nearest point on the polyline gets on top, should be repeated to a neighboring segment. further
PS. ray method sometimes gives an error - if the beam passes through the tangent to the path and not falling into one point of intersection gives the...
therefore, I developed another method that works fast enough...
good codeThank you ElpanovEvgeniy!
It does not take into account details.
1. As I said, if the closest point falls on the top, you need to jointly consider both segments.
2. check the direction of a polyline, written by Lee does not work with polylines having arc segments.
I wondered why the function "LM:ListClockwise-p " does not work with polylines having arc segments.
I see, thank you very much.I wondered why the function "LM:ListClockwise-p " does not work with polylines having arc segments.
which direction this lwpolyline?
The code Lee will give the wrong direction...
This is improved version:Hi Faster , good codes.
I wondered why the function "LM:ListClockwise-p " does not work with polylines having arc segments.
I think ElpanovEvgeniy's algorithm for Self-intersecting curves may be invalid!This is improved version:Hi Faster , good codes.
I wondered why the function "LM:ListClockwise-p " does not work with polylines having arc segments.
Test not ok for Self-intersecting curves , I post the test dwg .
I think ElpanovEvgeniy's algorithm for Self-intersecting curves may be invalid!
Why not use the winding number (http://en.wikipedia.org/wiki/Winding_number) of th curve to determine the overall direction?Hi Lee Mac , I try to use the method you suggest .
(defun c:test (/ en pt l num)
(setq en (car (entsel "\n Select a curve :")))
(setq l (get_closed_curve_pts en))
(while (setq pt (getpoint "\nSelect a point :"))
(if (equal (vlax-curve-getclosestpointto en pt) pt 1e-6)
;_point at curve
(princ "\Point at the curve .")
(progn
(setq num (get-widding-number l pt))
(princ (strcat "\n Counts" (rtos num 2 1)))
;_this often wrong result ...
(setq num (fix num));_?
;_how to use counts number ?
(cond ((< -1 num 1)
(alert "OUT ")
)
((< num 0)
(if (= (rem num 2) 0);_does this is correct ?
(alert "Curve clockwise , \n\r Point OUT")
(alert "Curve clockwise , \n\r Point IN")
)
)
(t
(if (= (rem num 2) 0);_does this is correct ?
(alert "Curve counter-clockwise , \n\r Point OUT")
(alert "Curve counter-clockwise , \n\r Point IN")
)
)
)
)))
(princ)
)
;;get points of a closed curve
(defun get_closed_curve_pts (en / ent et)
(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
)
)
)
(dxf 10 ent)
(dxf 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
)
)
)
)
)
;;
(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 (acos (/ e 2. b c))
g (/ d (abs d)))
(if (< e 0) (* g (- pi f))(* g f)))
)
))
(setq ang (+ ang an1))
)
(/ ang 2. pi)
)
;;------------------
(defun dxf (co el)
(cdr (assoc co el))
)
;;
(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
)
)
)
)
)
;;
(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 c:test (/ en pt l num)
(setq en (car (entsel "\n Select a curve :")))
(setq l (get_closed_curve_pts en))
(while (setq pt (getpoint "\nSelect a point :"))
(if (equal (vlax-curve-getclosestpointto en pt) pt 1e-6)
;_point at curve
(princ "\Point at the curve .")
(progn
(setq num (get-widding-number l pt))
(princ (strcat "\n Counts" (rtos num 2 1)))
;_this often wrong result , because of decimal precision ; Now correct .
(if (equal (fix num) num 1e-4)
(setq num (fix num))
(if (and (> num 0) (equal (1+ (fix num)) num 1e-4))
(setq num (1+ (fix num)))
(if (and (< num 0) (equal (1- (fix num)) num 1e-4))
(setq num (1- (fix num)))
(setq num (fix num)))))
;_how to use counts number ?
(cond ((< -1 num 1)
(alert "OUT ")
)
((< num 0)
(if (= (rem num 2) 0) ;_does this is correct ?
(alert "Curve clockwise , \n\r Point OUT")
(alert "Curve clockwise , \n\r Point IN")
)
)
(t
(if (= (rem num 2) 0) ;_does this is correct ?
(alert "Curve counter-clockwise , \n\r Point OUT")
(alert "Curve counter-clockwise , \n\r Point IN")
)
)
)
)
)
)
(princ)
)
;;get points of a closed curve
(defun get_closed_curve_pts (en / ent et)
(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
)
)
)
(dxf 10 ent)
(dxf 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
)
)
)
)
)
;;
(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)
)
;;------------------
(defun dxf (co el)
(cdr (assoc co el))
)
;;
(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
)
)
)
)
)
;;
(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))
;;; 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)
)
;;; maximum circle inscribed in a closed polyline
;;; Gian Paolo Cattaneo
(defun C:TesT (/ POLY POLY_vl Dx Dy
Lp List_vert_poly list_p_int
P_center dist step1 step2 t1
t2
)
(prompt "\nSelect Polyline: ")
(if (setq POLY (ssname (ssget ":S" '((0 . "LWPOLYLINE"))) 0))
(progn
(setq i 1
t1 (getvar "MilliSecs")
)
(setq step1 40) ;--> grid_1
(setq step2 20) ;--> grid_2
(setq list_vert_poly (LWPoly->List POLY 10))
(grid_1)
(Point_int)
(grid+)
(Point_center)
(repeat 2
(grid_2)
(Point_center)
)
(entmake
(list
(cons 0 "CIRCLE")
(cons 10 P_center)
(cons 40 dist)
)
)
(setq t2 (getvar "MilliSecs"))
(princ (strcat "time = " (rtos (- t2 t1) 2 0) " MilliSecs"))
(princ)
)
)
)
;; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata
;; Returns a grid of points within the BoundingBox of the selected poly
(defun grid_1 (/ p1 p2 X1 Y1 l1)
(vla-getboundingbox (vlax-ename->vla-object POLY) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
(setq Dx (/ (- (car p2) (car p1)) step1))
(setq Dy (/ (- (cadr p2) (cadr p1)) step1))
(setq Lp (list p1)
X1 (car p1)
Y1 (cadr p1)
)
(repeat step1
(setq Lp (cons (list (setq X1 (+ X1 Dx)) Y1) Lp))
)
(setq Lp (list Lp))
(repeat step1
(setq Lp (cons (mapcar (function (lambda (x)
(list (car x) (+ (cadr x) Dy))
)
)
(car lp)
) Lp)
)
)
(setq Lp (apply (function append) Lp))
)
;; Restituisce una griglia di punti intorno al punto centrale (provvisorio)
;; Returns a grid of points around the center point (provisional)
(defun grid_2 (/ P1_ P> n)
(setq list_p_int nil)
(setq P1_ (list (- (car P_center) (* Dx 2))
(- (cadr P_center) (* Dy 2))
)
)
(setq Dx (/ (* 4 Dx) step2))
(setq Dy (/ (* 4 Dy) step2))
(setq n 0)
(setq P> P1_)
(setq list_p_int (list P1_))
(repeat (* (1+ step2) step2)
(setq P> (list (+ (car P>) Dx) (cadr P>)))
(setq list_p_int (cons P> list_p_int))
(setq n (1+ n))
(if (= n step2)
(progn
(setq n 0)
(setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
(setq P> P1_)
(setq list_p_int (cons P> list_p_int))
)
)
)
)
;; restituisce la lista dei punti interni ad un poligono
;; dati: - lista coordinate dei punti -> Lp
;; - lista coordinate vertici poligono -> list_vert_poly
;; Returns the list of points inside the polyline
(defun Point_int (/ n Pr cont attr p# Pa Pa_ Pb)
(setq list_p_int nil)
(foreach Pr Lp
(if (> (Point-in-ClosedCurve-p list_vert_poly Pr) 0)
(setq list_p_int (cons Pr list_p_int))
)
)
)
;; Infittisce la griglia inserendo altri punti
;; nel centro delle diagonali tra i punti interni
;; Insert points (interior) to increase the density of the grid
(defun grid+ (/ G+)
(setq G+
(mapcar '(lambda (x)
(list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))
)
list_p_int
)
)
(setq list_p_int (append G+ list_p_int))
)
;; Da una lista di punti restituisce quello pił lontano da un oggetto
;; dati: - lista dei punti -> list_p_int
;; - oggetto -> POLY_vl
;; Returns the farthest point from the polyline
(defun Point_center (/ Pa n Pvic)
(setq Dist 1e-7)
(setq P_center nil)
(foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo Poly Pa))
(if (> (distance Pa Pvic) Dist)
(progn
(setq P_center Pa)
(setq Dist (distance Pa Pvic))
)
)
)
)
;;
(defun LWPoly->List (en acc / a b vetex bu p1 p2 l r ang an1 N)
;;Acc --- 0 ~ 99
(setq ent (entget en))
(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)))
N (min N (1+ Acc))
)
(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
)
;;
;; This method suggest by Lee Mac from http://en.wikipedia.org/wiki/Winding_number
;; function : determin the point position with the closed curve by widding-number method
;; l ---- point set of a Closed Curve , First item must same as Last item .
;; pt ---- a given point to determin position with the Closed Curve
;;; return a num
;;; ---- -1 pt out of curve
;;; ---- 0 pt at curve
;;; ---- 1 pt in curve
;; by GSLS(SS) 2012-08-02
(defun Point-in-ClosedCurve-p (l pt / ang p1 p2 n r at)
(setq ang 0.0
at nil
)
(while (and (cadr l) (not at))
(setq p1 (car l)
p2 (cadr l)
l (cdr l)
)
(if (equal p1 p2 1e-6)
(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)))
)
)
(if (and (equal d 0.0 1e-4) (setq at T))
pi
(progn
(setq
e (+ (* b b) (* c c) (* -1 a a))
f (abs ((lambda (x)
(cond ((equal x 0.0 1e-6)(* pi 0.5))
((equal x 1.0 1e-6)0.0)
((atan (/ (sqrt (- 1 (* x x)))
x
)
))
))
(/ e 2. b c)
)
)
g (if (> d 0) 1 -1)
)
(if (< e 0)
(* g (- pi f))
(* g f)
)
)
)
)
)
)
)
(setq ang (+ ang an1))
)
;;deal widding number
(if at
0
(progn
(setq n (/ ang 2. pi))
(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)
-1
1
)
)
)
)
;|
(defun c:t1 ( / en l n)
(setq en (car (entsel))
l (LWPoly->List en 10))
(while (setq pt (getpoint ))
(setq n (Point-in-ClosedCurve-p l pt))
(cond ((> n 0)
(alert "IN"))
((= n 0)
(alert "AT"))
(t
(alert "OUT")))))
|;
Acordding GP's method and codes , and determine pt-in-curve by the method Lee Mac suggest .
It can supports self-intersection , butthe problem that it ps. not correct result yet be there , unless the setp1 is enough great .
The codes get-widding-number seems so poor, Need your improving .( I guess this method used in AutoCAD interface , but didn't know how get it )Code: [Select].................
.................
;; Returns the list of points inside the polyline
(defun Point_int (/ n Pr cont attr p# Pa Pa_ Pb)
(setq list_p_int nil)
(foreach Pr Lp
(if (> (Point-in-ClosedCurve-p list_vert_poly Pr) 0)
(setq list_p_int (cons Pr list_p_int))
)
)
)
...................
...................
The points inside are not calculated correctly.Thank you for test , I'll check it .
The points inside are not calculated correctly.Change the widding number's rounding accuracy 1e-4 into 1e-3 or 1e-2 will correct this problem .
;;
;; This method suggest by Lee Mac from http://en.wikipedia.org/wiki/Winding_number
;; function : determin the point position with the closed curve by widding-number method
;; l ---- point set of a Closed Curve , First item must same as Last item .
;; pt ---- a given point to determin position with the Closed Curve
;; return a num
;; ---- -1 pt out of curve
;; ---- 0 pt at curve
;; ---- 1 pt in curve
;; by GSLS(SS) 2012-08-02
;; Edited : Change widding number's Acc 1e-4 into 1e-2 ,
;; for checking point in or out it's a integer
(defun Point-in-ClosedCurve-p (l pt / ang p1 p2 n r at)
(setq ang 0.0
at nil
)
(while (and (cadr l) (not at))
(setq p1 (car l)
p2 (cadr l)
l (cdr l)
)
(if (equal p1 p2 1e-6)
(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)))
)
)
(if (and (equal d 0.0 1e-4) (setq at T))
pi
(progn
(setq
e (+ (* b b) (* c c) (* -1 a a))
f (abs ((lambda (x)
(cond ((equal x 0.0 1e-6)(* pi 0.5))
((equal x 1.0 1e-6)0.0)
((atan (/ (sqrt (- 1 (* x x)))
x
)
))
))
(/ e 2. b c)
)
)
g (if (> d 0) 1 -1)
)
(if (< e 0)
(* g (- pi f))
(* g f)
)
)
)
)
)
)
)
(setq ang (+ ang an1))
)
;;deal widding number
(if at
0
(progn
(setq n (/ ang 2. pi))
(if (and (> n 0) (equal (1+ (fix n)) n 1e-2))
;_Change Acc 1e-4 to 1e-2 for correct 2012-8-3
(setq n (1+ (fix n)))
(if (and (< n 0) (equal (1- (fix n)) n 1e-2))
;_Change Acc 1e-4 to 1e-2 for correct 2012-8-3
(setq n (1- (fix n)))
(setq n (fix n))
)
)
(if (= (rem n 2) 0)
-1
1
)
)
)
)
;;; maximum circle inscribed in a closed polyline
;;; Gian Paolo Cattaneo
(defun C:TesT (/ POLY POLY_vl Dx Dy
Lp List_vert_poly list_p_int
P_center dist step1 step2 t1
t2
)
(prompt "\nSelect Polyline: ")
(if (setq POLY (ssname (ssget ":S" '((0 . "LWPOLYLINE"))) 0))
(progn
(setq i 1
t1 (getvar "MilliSecs")
)
(setq step1 40) ;--> grid_1
(setq step2 20) ;--> grid_2
(setq list_vert_poly (LWPoly->List POLY 99))
(grid_1)
(Point_int)
(foreach a list_p_int
(entmake (list (cons 0 "POINT")
(cons 10 a))
)
)
(grid+)
(Point_center)
(repeat 2
(grid_2)
(Point_center)
)
(entmake
(list
(cons 0 "CIRCLE")
(cons 10 P_center)
(cons 40 dist)
)
)
(setq t2 (getvar "MilliSecs"))
(princ (strcat "time = " (rtos (- t2 t1) 2 0) " MilliSecs"))
(princ)
)
)
)
(defun Point-in-ClosedCurve-p (l pt / ang p1 p2 n r at)
(setq ang 0.0)
(while (and (cadr l) (not at))
(setq p1 (car l)
p2 (cadr l)
l (cdr l)
an1 (- (angle pt p2) (angle pt p1))
)
(if (< an1 (- pi))
(setq an1 (+ an1 pi pi))
(if (> an1 pi)
(setq an1 (- an1 pi pi))
)
)
(if (equal (abs an1) pi 1e-14)
(setq at T)
)
(setq ang (+ ang an1))
)
;;deal widding number
(if at
0
(progn
(setq n (/ ang 2. pi))
(if (and (> n 0) (equal (1+ (fix n)) n 1e-2))
;_Change Acc 1e-4 to 1e-2 for correct 2012-8-3
(setq n (1+ (fix n)))
(if (and (< n 0) (equal (1- (fix n)) n 1e-2))
;_Change Acc 1e-4 to 1e-2 for correct 2012-8-3
(setq n (1- (fix n)))
(setq n (fix n))
)
)
(if (= (rem n 2) 0)
-1
1
)
)
)
)
(setq area (vlax-curve-getArea poly)
len (vlax-curve-getDistAtParam poly (vlax-curve-getEndParam poly)))
(setq step1 (max 10 (fix (/ len 0.4 (sqrt area)))));_--> grid_1
2. Force step2 into 10 , because 10 equal grid is enough to make the radius improve the accuracy of a rating;;old grid_2 area
+ + + + +
+ + + + +
+ + o + +
+ + + + +
+ + + + +
;;new grid_2 area
+ + +
+ o +
+ + +
4. Use radius accuracy to control the loop , 'While' method replace 'Repeat' method .;;; maximum circle inscribed in a closed polyline
;;; writed by Gian Paolo Cattaneo
;;; edited by GSLS(SS) 2012-8-5
(defun C:TesT (/ POLY POLY_vl Dx Dy
Lp List_vert_poly list_p_int
P_center dist step1 step2 t1
t2 R0 area len i
)
(gc)
(prompt "\nSelect Polyline: ")
(if (setq POLY (ssname (ssget ":S" '((0 . "LWPOLYLINE"))) 0))
(progn
(setq i 1
t1 (getvar "MilliSecs")
)
(setq area (vlax-curve-getArea poly)
len (vlax-curve-getDistAtParam poly (vlax-curve-getEndParam poly)))
(setq step1 (max 10 (fix (/ len 0.4 (sqrt area)))));_--> grid_1
(setq step2 10);_--> grid_2
(setq list_vert_poly (LWPoly->List POLY 10))
(grid_1)
(Point_int)
(grid+)
(Point_center)
(setq i 0)
(while (and (> (- Dist R0) 1e-8)(< i 10))
(grid_2)
(Point_center)
(setq i (1+ i))
)
(entmake
(list
(cons 0 "CIRCLE")
(cons 10 P_center)
(cons 40 dist)
)
)
(setq t2 (getvar "MilliSecs"))
(princ (strcat "time = " (rtos (- t2 t1) 2 0) " MilliSecs"))
(princ)
)
)
)
;; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata
;; Returns a grid of points within the BoundingBox of the selected poly
(defun grid_1 (/ p1 p2 X1 Y1 l1)
(vla-getboundingbox (vlax-ename->vla-object POLY) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
(setq Dx (/ (- (car p2) (car p1)) step1))
(setq Dy (/ (- (cadr p2) (cadr p1)) step1))
(setq Lp (list p1)
X1 (car p1)
Y1 (cadr p1)
)
(repeat step1
(setq Lp (cons (list (setq X1 (+ X1 Dx)) Y1) Lp))
)
(setq Lp (list Lp))
(repeat step1
(setq Lp (cons (mapcar (function (lambda (x)
(list (car x) (+ (cadr x) Dy))
)
)
(car lp)
)
Lp
)
)
)
(setq Lp (apply (function append) Lp))
)
;; Restituisce una griglia di punti intorno al punto centrale (provvisorio)
;; Returns a grid of points around the center point (provisional)
(defun grid_2 (/ X1 Y1 P1)
(setq list_p_int nil
X1 (- (car P_center) Dx)
Y1 (- (cadr P_center) Dy)
P1 (list X1 Y1)
Dx (/ (* 2 Dx) step2)
Dy (/ (* 2 Dy) step2)
)
(setq list_p_int (list P1))
(repeat step2
(setq list_p_int (cons (list (setq X1 (+ X1 Dx)) Y1) list_p_int))
)
(setq list_p_int (list list_p_int))
(repeat step2
(setq list_p_int
(cons (mapcar (function (lambda (x)
(list (car x) (+ (cadr x) Dy))
)
)
(car list_p_int)
)
list_p_int
)
)
)
(setq list_p_int (apply (function append) list_p_int))
)
;; restituisce la lista dei punti interni ad un poligono
;; dati: - lista coordinate dei punti -> Lp
;; - lista coordinate vertici poligono -> list_vert_poly
;; Returns the list of points inside the polyline
(defun Point_int (/ n Pr cont attr p# Pa Pa_ Pb)
(setq list_p_int nil)
(foreach Pr Lp
(if (> (Point-in-ClosedCurve-p list_vert_poly Pr) 0)
(setq list_p_int (cons Pr list_p_int))
)
)
)
;; Infittisce la griglia inserendo altri punti
;; nel centro delle diagonali tra i punti interni
;; Insert points (interior) to increase the density of the grid
(defun grid+ (/ G+)
(setq G+
(mapcar '(lambda (x)
(list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))
)
list_p_int
)
)
(setq list_p_int (append G+ list_p_int))
)
;; Da una lista di punti restituisce quello pił lontano da un oggetto
;; dati: - lista dei punti -> list_p_int
;; - oggetto -> POLY_vl
;; Returns the farthest point from the polyline
(defun Point_center (/ Pa Pvic)
(foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo Poly Pa))
(if (> (distance Pa Pvic) Dist)
(setq P_center Pa
R0 Dist
Dist (distance Pa Pvic))
)
)
)
;;
(defun LWPoly->List (en acc / a b vetex bu p1 p2 l r ang an1 N)
;;Acc --- 0 ~ 99
(setq ent (entget en))
(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)))
N (min N (1+ Acc))
)
(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)
l (cons (polar c ang r) l)
)
)
(setq l (cons p1 l))
)
)
)
)
)
l
)
;;
;; This method suggest by Lee Mac from http://en.wikipedia.org/wiki/Winding_number
;; function : determin the point position with the closed curve by widding-number method
;; l ---- point set of a Closed Curve , First item must same as Last item .
;; pt ---- a given point to determin position with the Closed Curve
;; return a num
;; ---- -1 pt out of curve
;; ---- 0 pt at curve
;; ---- 1 pt in curve
;; by GSLS(SS) 2012-08-02
;; Edited : Change widding number's Acc 1e-4 into 1e-2 ,
;; for checking point in or out it's a integer
;; Edited 2012-8-5
;; Improved vector angle calculation , only use angle function .
;;
(defun Point-in-ClosedCurve-p (l pt / ang p1 p2 n r at)
(setq ang 0.0)
(while (and (cadr l) (not at))
(setq p1 (car l)
p2 (cadr l)
l (cdr l)
an1 (- (angle pt p2) (angle pt p1))
)
(if (< an1 (- pi))
(setq an1 (+ an1 pi pi))
(if (> an1 pi)
(setq an1 (- an1 pi pi))
)
)
(if (equal (abs an1) pi 1e-14);_If it's just used to solve the maximum radius of the circle,
;_here's precision 1e-14 can be set lower , such as 1e-1 ,
;_this will exclude the point of the curve edge .
;_but for ultra-narrow four-point rectangle will generate an error .
(setq at T)
)
(setq ang (+ ang an1))
)
;;deal widding number
(if at
0
(progn
(setq n (/ ang 2. pi))
(if (and (> n 0) (equal (1+ (fix n)) n 1e-2))
(setq n (1+ (fix n)))
(if (and (< n 0) (equal (1- (fix n)) n 1e-2))
(setq n (1- (fix n)))
(setq n (fix n))
)
)
(if (= (rem n 2) 0)
-1
1
)
)
)
)
Any suggestions are welcome .
;;; maximum circle inscribed in a closed polyline
;;; writed by Gian Paolo Cattaneo
;;; edited by GSLS(SS) 2012-8-5
(defun C:TesT (/ POLY POLY_vl Dx Dy Lp
List_vert_poly list_p_int P_center dist
step1 step2 t1 t2 t3 t4 R0 area
len i
)
(gc)
(prompt "\nSelect Polyline: ")
(if (setq POLY (ssname (ssget ":S" '((0 . "LWPOLYLINE"))) 0))
(progn
(setq i 1)
(setq area (vlax-curve-getArea poly)
len (vlax-curve-getDistAtParam
poly
(vlax-curve-getEndParam poly)
)
)
(setq step1 (max 10 (fix (/ len 0.4 (sqrt area))))) ;_--> grid_1
(setq step2 10) ;_--> grid_2
(setq list_vert_poly (LWPoly->List POLY 10))
(grid_1)
(setq t1 (getvar "MilliSecs"))
(Point_int)
(setq t2 (getvar "MilliSecs"))
;|
(foreach a list_p_int
(entmake (list (cons 0 "POINT")
(cons 10 a)
(cons 62 3))))|;
;_(grid+)
(Point_center)
(setq t3 (getvar "MilliSecs"))
(setq i 0)
(while (and (> (- Dist R0) 1e-8) (< i 10))
(grid_2)
(Point_center)
(setq i (1+ i))
)
(setq t4 (getvar "MilliSecs"))
(entmake
(list
(cons 0 "CIRCLE")
(cons 10 P_center)
(cons 40 dist)
)
)
(princ
(strcat "\ntime1 = " (rtos (- t2 t1) 2 0) " MilliSecs")
)
(princ
(strcat "\ntime2 = " (rtos (- t3 t2) 2 0) " MilliSecs")
)
(princ
(strcat "\ntime3 = " (rtos (- t4 t3) 2 0) " MilliSecs")
)
(princ)
)
)
)
;; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata
;; Returns a grid of points within the BoundingBox of the selected poly
(defun grid_1 (/ p1 p2 X1 Y1 l1)
(vla-getboundingbox (vlax-ename->vla-object POLY) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
(setq Dx (/ (- (car p2) (car p1)) step1))
(setq Dy (/ (- (cadr p2) (cadr p1)) step1))
(setq Lp (list p1)
X1 (car p1)
Y1 (cadr p1)
)
(repeat step1
(setq Lp (cons (list (setq X1 (+ X1 Dx)) Y1) Lp))
)
(setq Lp (list Lp))
(repeat step1
(setq Lp (cons (mapcar (function (lambda (x)
(list (car x) (+ (cadr x) Dy))
)
)
(car lp)
)
Lp
)
)
)
(setq Lp (apply (function append) Lp))
)
;; Restituisce una griglia di punti intorno al punto centrale (provvisorio)
;; Returns a grid of points around the center point (provisional)
(defun grid_2 (/ X1 Y1 P1)
(setq list_p_int nil
X1 (- (car P_center) Dx)
Y1 (- (cadr P_center) Dy)
P1 (list X1 Y1)
Dx (/ (* 2 Dx) step2)
Dy (/ (* 2 Dy) step2)
)
(setq list_p_int (list P1))
(repeat step2
(setq list_p_int (cons (list (setq X1 (+ X1 Dx)) Y1) list_p_int))
)
(setq list_p_int (list list_p_int))
(repeat step2
(setq list_p_int
(cons (mapcar (function (lambda (x)
(list (car x) (+ (cadr x) Dy))
)
)
(car list_p_int)
)
list_p_int
)
)
)
(setq list_p_int (apply (function append) list_p_int))
)
;; restituisce la lista dei punti interni ad un poligono
;; dati: - lista coordinate dei punti -> Lp
;; - lista coordinate vertici poligono -> list_vert_poly
;; Returns the list of points inside the polyline
(defun Point_int ()
(setq list_p_int
(vl-remove-if-not
(function
(lambda (pt)
;_determine point in curve , use widding number
(equal
PI
(abs
(apply
(function +)
(mapcar (function (lambda (x y / a)
(rem (- (angle pt x) (angle pt y)) PI)
)
)
list_vert_poly
(cdr list_vert_poly)
)
)
)
1e-8
)
)
)
Lp
)
)
)
;; Infittisce la griglia inserendo altri punti
;; nel centro delle diagonali tra i punti interni
;; Insert points (interior) to increase the density of the grid
(defun grid+ (/ G+)
(setq G+
(mapcar '(lambda (x)
(list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))
)
list_p_int
)
)
(setq list_p_int (append G+ list_p_int))
)
;; Da una lista di punti restituisce quello pił lontano da un oggetto
;; dati: - lista dei punti -> list_p_int
;; - oggetto -> POLY_vl
;; Returns the farthest point from the polyline
(defun Point_center (/ Pa Pvic)
(foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo Poly Pa))
(if (> (distance Pa Pvic) Dist)
(setq P_center Pa
R0 Dist
Dist (distance Pa Pvic)
)
)
)
)
;;
(defun LWPoly->List (en acc / a b vetex bu p1 p2 l r ang an1 N)
;;Acc --- 0 ~ 99
(setq ent (entget en))
(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)))
N (min N (1+ Acc))
)
(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)
l (cons (polar c ang r) l)
)
)
(setq l (cons p1 l))
)
)
)
)
)
l
)
fixed a bug:I just state fact , you are always so humble :-)
;;; writed byGian Paolo CattaneoGSLS(SS)
:-)