Use GP's method :
Some change will improve the speed and accuracy .
1. To suit for any complex tubular closed curve , Use the ratio of circumference and area to optimize the number of grids in the step 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
3. change the 'Grid_2' routine's area
;;old grid_2 area
+ + + + +
+ + + + +
+ + o + +
+ + + + +
+ + + + +
;;new grid_2 area
+ + +
+ o +
+ + +
4. Use radius accuracy to control the loop , 'While' method replace 'Repeat' method .
In most cases, will improve the speed .
5. Limits the number of the while loop, to adapt to the rectangle .
Codes Following
;;; 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 .