Smallest Circumscribing Circle

[marko_ribar]

This is my best try, and I think that will do it :

 

(vl-load-com) (princ)

;;;"By Lee Mac, sourced from www.lee-mac.com/groupbynum.html";;;
(defun LM:GetIntersections ( obj1 obj2 )
 (LM:GroupByNum (vlax-invoke obj1 'IntersectWith obj2 acExtendNone) 3)
)

(defun LM:GroupByNum ( l n / r)
 (if l
   (cons
     (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
     (LM:GroupByNum l n)
   )
 )
)

(defun interse1e2 ( e1 e2 / lst )
 (if (and e1 e2)
   (setq lst (LM:GetIntersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
 )
 lst
)

;; Minimum Enclosing Circle  -  Lee Mac
;; Implements the algorithm by Pr.Chrystal (1885) using the Convex Hull
;; to determine the Minimum Enclosing Circle of a point set.

(defun LM:MinEncCircle ( lst / _sub )

   (defun _sub ( p1 p2 l1 / a1 a2 l2 p3 p4 )
       (setq l2 (LM:RemoveWithFuzz (list p1 p2) l1 1e-
             p3 (car l2)
             a1 (LM:GetInsideAngle p1 p3 p2)
       )
       (foreach p4 (cdr l2)
           (if (< (setq a2 (LM:GetInsideAngle p1 p4 p2)) a1)
               (setq p3 p4 a1 a2)
           )
       )
       (cond
           (   (<= (/ pi 2.0) a1)
               (list (mid p1 p2) (/ (distance p1 p2) 2.0))
           )
           (   (vl-some
                   (function
                       (lambda ( a b c )
                           (if (< (/ pi 2.0) (LM:GetInsideAngle a b c)) (_sub a c l1))
                       )
                   )
                   (list p1 p1 p2) (list p2 p3 p1) (list p3 p2 p3)
               )
           )
           (   (LM:3PCircle p1 p2 p3)   )
       )
   )

   ((lambda ( lst ) (_sub (car lst) (cadr lst) lst)) (LM:ConvexHull lst))
)

;; Remove With Fuzz  -  Lee Mac
;; Removes items from a list which are equal to a supplied tolerance

(defun LM:RemoveWithFuzz ( l1 l2 fz )
   (vl-remove-if
       (function
           (lambda ( a )
               (vl-some
                   (function (lambda ( b ) (equal a b fz)))
                   l1
               )
           )
       )
       l2
   )
)

;; Get Inside Angle  -  Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2

(defun LM:GetInsideAngle ( p1 p2 p3 )
   (   (lambda ( a ) (min a (- (+ pi pi) a)))
       (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
   )
)

;; 3-Point Circle  -  Lee Mac
;; Returns the Center and Radius of the Circle defined by
;; the supplied three points.

(defun LM:3PCircle ( p1 p2 p3 / cn m1 m2 )
   (setq m1 (mid p1 p2)
         m2 (mid p2 p3)
   )
   (list
       (setq cn
           (inters
               m1 (polar m1 (+ (angle p1 p2) (/ pi 2.)) 1.0)
               m2 (polar m2 (+ (angle p2 p3) (/ pi 2.)) 1.0)
               nil
           )
       )
       (distance cn p1)
   )
)

;; Midpoint - Lee Mac
;; Returns the midpoint of two points

(defun mid ( a b )
   (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to determine the
;; Convex Hull of a list of points.

(defun LM:ConvexHull ( lst / hul p0 )
   (cond
       (   (< (length lst) 4)
           lst
       )
       (   t
           (setq p0 (car lst))
           (foreach p1 (cdr lst)
               (if (or (< (cadr p1) (cadr p0))
                       (and (equal (cadr p1) (cadr p0) 1e- (< (car p1) (car p0)))
                   )
                   (setq p0 p1)
               )
           )
           (setq lst
               (vl-sort lst
                   (function
                       (lambda ( a b / c d )
                           (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-
                               (< (distance p0 a) (distance p0 b))
                               (< c d)
                           )
                       )
                   )
               )
           )
           (setq hul (list (caddr lst) (cadr lst) (car lst)))
           (foreach pt (cdddr lst)
               (setq hul (cons pt hul))
               (while (and (caddr hul) (LM:Clockwise-p (caddr hul) (cadr hul) pt))
                   (setq hul (cons pt (cddr hul)))
               )
           )
           hul
       )
   )
)

;; 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
   )
)

;; LWPolyline to Point List  -  Lee Mac
;; Returns a list of points describing the supplied LWPolyline

(defun LM:LWPoly->List ( ent n / 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-
               (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 (* n (/ (- 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
)

(defun FurthestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (< d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

(defun NearestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq lst (vl-remove pt lst))
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (> d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

;; Test Function

(defun c:circumpline ( / APP CI CII EN N OSM PT PTA1 PTA11 PTA2 PTA22 PTA3 PTL PTSE1E2ARCS TST X )
   (setq app (getvar 'aperture))
   (setq osm (getvar 'osmode))
   (setvar 'aperture 25)
   (setvar 'osmode 0)
   (while
       (progn (setvar 'ERRNO 0) (setq en (car (entsel "\nSelect LWPolyline: ")))
           (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ENAME (type en))
                   (if (not (eq "LWPOLYLINE" (cdr (assoc 0 (entget en)))))
                       (princ "\nInvalid Object Selected.")
                   )
               )
           )
       )
   )
   (initget 6)
   (setq n (getint "\nInput number for level of segmetation <360> - larger the number (slower), smaller the number (faster) : "))
   (if (null n) (setq n 360))
   (if
       (and en
           (setq lst
               (mapcar
                   (function (lambda ( x ) (trans x 0 en)))
                   (LM:LWPoly->List en n)
               )
           )
           (setq lst (LM:MinEncCircle lst))
       )
       (setq ci 
       (entmakex
           (list
               (cons 0 "CIRCLE")
               (cons 10 (car  lst))
               (cons 40 (cadr lst))
               (cons 62 2)
               (assoc 210 (entget en))
           )
       ))
   )
   (setq ptse1e2 (interse1e2 en ci))
   (setq plpts (mapcar '(lambda (x) (cdr x)) (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en)) ))
   (foreach pt ptse1e2
       (mapcar '(lambda (x) (if (equal (list (car pt) (cadr pt)) x 1e-6) (progn (setq tst (cons T tst)) (setq ptl (cons pt ptl))  ))) plpts)
   )
   (if (and (= (length tst) 2) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq ptse1e2arcs (vl-remove (cadr ptl) ptse1e2arcs))
       (entdel ci)
   (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_end" (cadr ptl) "_tan" (car ptse1e2arcs))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 3))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (entdel ci)
   (vl-cmdf "_.circle" "2P" "_end" (car ptl) "_tan" (car ptse1e2arcs))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 5))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq pta1 (car ptse1e2arcs))
       (setq pta2 (FurthestFromPoint ptse1e2arcs pta1))        
       (entdel ci)
   (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_tan" pta1 "_tan" pta2)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 6))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (setq pta22 (NearestFromPoint ptse1e2arcs pta2))
       (setq ptse1e2arcs (vl-remove pta22 ptse1e2arcs))
   (setq ptse1e2arcs (vl-remove pta1 ptse1e2arcs))
   (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta3 (NearestFromPoint ptse1e2arcs pta2))
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_tan" pta1 "_tan" pta2 "_tan" pta3)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (entdel ci)
       (vl-cmdf "_.circle" "2P" "_tan" pta1 "_tan" pta2)
       )
   )
   (setvar 'aperture app)
   (setvar 'osmode osm)
   (princ)
)

M.R.

Edited October 18, 2011 by marko_ribar
code finally revised

[marko_ribar]

I can't believe that no one haven't noticed where my error was...

 

Regards, M.R. (arch.)

 

BTW., Lee your algorithm works perfectly...

[Manila Wolf]

Hi Guys,

 

Both Lee Mac's and Marko's codes work very well.

With my lack of lisp knowledge, I am unable to decipher the differences and relative merits between the two codes.

 

Regarding user input, for me and what I personally need the code for, the less interruptions the better. Right now, I have Lee Mac's code loaded, where I cranked up the variable 25 up to 200. It works very well and very quickly on my machine.

 

Is it possible to enhance further by giving a readout of the resultant diameter.

It's easy I know to manually use the "dimdiameter" command after the code has run, but would be nice if this could be implemented in the automation.

The AutoCAD "List" command only gives the radius. No big deal to multiply this by two, but still, the less steps the better.

 

Great work chaps.

 

A new lisp routine that would produce a cold bottle of beer every 35.66663 minutes at approx 153.66658mm NNE of my mousepad would also be very welcome. I am guessing how to remove the bottle top will give you the most headaches. The code must make sure the bottle does not interfere with my ash tray. Thanks in advance.

[marko_ribar]

Final touch... It didn't worked well in this case (see attached *.dwg), so I highlighted my modifications, mistake was on 1e-8 decimal, and intersectwith function couldn't find results, so I reduced r of Lee's circle for 1e-8, and finally removed duplicates points in list with points obtained by intersectwith function :

 

(vl-load-com) (princ)

;;;"By Lee Mac, sourced from www.lee-mac.com/groupbynum.html";;;
(defun LM:GetIntersections ( obj1 obj2 )
 (LM:GroupByNum (vlax-invoke obj1 'IntersectWith obj2 acExtendNone) 3)
)

(defun LM:GroupByNum ( l n / r)
 (if l
   (cons
     (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
     (LM:GroupByNum l n)
   )
 )
)

(defun interse1e2 ( e1 e2 / lst )
 (if (and e1 e2)
   (setq lst (LM:GetIntersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
 )
 lst
)

;; Minimum Enclosing Circle  -  Lee Mac
;; Implements the algorithm by Pr.Chrystal (1885) using the Convex Hull
;; to determine the Minimum Enclosing Circle of a point set.

(defun LM:MinEncCircle ( lst / _sub )

   (defun _sub ( p1 p2 l1 / a1 a2 l2 p3 p4 )
       (setq l2 (LM:RemoveWithFuzz (list p1 p2) l1 1e-
             p3 (car l2)
             a1 (LM:GetInsideAngle p1 p3 p2)
       )
       (foreach p4 (cdr l2)
           (if (< (setq a2 (LM:GetInsideAngle p1 p4 p2)) a1)
               (setq p3 p4 a1 a2)
           )
       )
       (cond
           (   (<= (/ pi 2.0) a1)
               (list (mid p1 p2) (/ (distance p1 p2) 2.0))
           )
           (   (vl-some
                   (function
                       (lambda ( a b c )
                           (if (< (/ pi 2.0) (LM:GetInsideAngle a b c)) (_sub a c l1))
                       )
                   )
                   (list p1 p1 p2) (list p2 p3 p1) (list p3 p2 p3)
               )
           )
           (   (LM:3PCircle p1 p2 p3)   )
       )
   )

   ((lambda ( lst ) (_sub (car lst) (cadr lst) lst)) (LM:ConvexHull lst))
)

;; Remove With Fuzz  -  Lee Mac
;; Removes items from a list which are equal to a supplied tolerance

(defun LM:RemoveWithFuzz ( l1 l2 fz )
   (vl-remove-if
       (function
           (lambda ( a )
               (vl-some
                   (function (lambda ( b ) (equal a b fz)))
                   l1
               )
           )
       )
       l2
   )
)

;; Get Inside Angle  -  Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2

(defun LM:GetInsideAngle ( p1 p2 p3 )
   (   (lambda ( a ) (min a (- (+ pi pi) a)))
       (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
   )
)

;; 3-Point Circle  -  Lee Mac
;; Returns the Center and Radius of the Circle defined by
;; the supplied three points.

(defun LM:3PCircle ( p1 p2 p3 / cn m1 m2 )
   (setq m1 (mid p1 p2)
         m2 (mid p2 p3)
   )
   (list
       (setq cn
           (inters
               m1 (polar m1 (+ (angle p1 p2) (/ pi 2.)) 1.0)
               m2 (polar m2 (+ (angle p2 p3) (/ pi 2.)) 1.0)
               nil
           )
       )
       (distance cn p1)
   )
)

;; Midpoint - Lee Mac
;; Returns the midpoint of two points

(defun mid ( a b )
   (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to determine the
;; Convex Hull of a list of points.

(defun LM:ConvexHull ( lst / hul p0 )
   (cond
       (   (< (length lst) 4)
           lst
       )
       (   t
           (setq p0 (car lst))
           (foreach p1 (cdr lst)
               (if (or (< (cadr p1) (cadr p0))
                       (and (equal (cadr p1) (cadr p0) 1e- (< (car p1) (car p0)))
                   )
                   (setq p0 p1)
               )
           )
           (setq lst
               (vl-sort lst
                   (function
                       (lambda ( a b / c d )
                           (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-
                               (< (distance p0 a) (distance p0 b))
                               (< c d)
                           )
                       )
                   )
               )
           )
           (setq hul (list (caddr lst) (cadr lst) (car lst)))
           (foreach pt (cdddr lst)
               (setq hul (cons pt hul))
               (while (and (caddr hul) (LM:Clockwise-p (caddr hul) (cadr hul) pt))
                   (setq hul (cons pt (cddr hul)))
               )
           )
           hul
       )
   )
)

;; 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
   )
)

;; LWPolyline to Point List  -  Lee Mac
;; Returns a list of points describing the supplied LWPolyline

(defun LM:LWPoly->List ( ent n / 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-
               (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 (* n (/ (- 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
)

(defun FurthestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (< d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

(defun NearestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq lst (vl-remove pt lst))
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (> d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

;; Test Function

(defun c:circumpline ( / APP CI EN N OSM PT PTA1 PTA11 PTA2 PTA22 PTA3 PTL PTSE1E2ARCS TST X )
   (setq app (getvar 'aperture))
   (setq osm (getvar 'osmode))
   (setvar 'aperture 25)
   (setvar 'osmode 0)
   (while
       (progn (setvar 'ERRNO 0) (setq en (car (entsel "\nSelect LWPolyline: ")))
           (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ENAME (type en))
                   (if (not (eq "LWPOLYLINE" (cdr (assoc 0 (entget en)))))
                       (princ "\nInvalid Object Selected.")
                   )
               )
           )
       )
   )
   (initget 6)
   (setq n (getint "\nInput number for level of segmetation <360> - larger the number (slower), smaller the number (faster) : "))
   (if (null n) (setq n 360))
   (if
       (and en
           (setq lst
               (mapcar
                   (function (lambda ( x ) (trans x 0 en)))
                   (LM:LWPoly->List en n)
               )
           )
           (setq lst (LM:MinEncCircle lst))
       )
       (setq ci 
       (entmakex
           (list
               (cons 0 "CIRCLE")
               (cons 10 (car  lst))
               (cons 40 [highlight](- (cadr lst) 1e-9))[/highlight]
               (cons 62 2)
               (assoc 210 (entget en))
           )
       ))
   )
   (setq ptse1e2 (interse1e2 en ci))
   [highlight](setq ptse1e2 (acet-list-remove-duplicates ptse1e2 1e-6))[/highlight]
   (setq plpts (mapcar '(lambda (x) (cdr x)) (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en)) ))
   (foreach pt ptse1e2
       (mapcar '(lambda (x) (if (equal (list (car pt) (cadr pt)) x 1e-6) (progn (setq tst (cons T tst)) (setq ptl (cons pt ptl))  ))) plpts)
   )
   (if (and (= (length tst) 2) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq ptse1e2arcs (vl-remove (cadr ptl) ptse1e2arcs))
       (entdel ci)
   (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_end" (cadr ptl) "_tan" (car ptse1e2arcs))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 3))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (entdel ci)
   (vl-cmdf "_.circle" "2P" "_end" (car ptl) "_tan" (car ptse1e2arcs))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 5))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq pta1 (car ptse1e2arcs))
       (setq pta2 (FurthestFromPoint ptse1e2arcs pta1))        
       (entdel ci)
   (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_tan" pta1 "_tan" pta2)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 6))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (setq pta22 (NearestFromPoint ptse1e2arcs pta2))
       (setq ptse1e2arcs (vl-remove pta22 ptse1e2arcs))
   (setq ptse1e2arcs (vl-remove pta1 ptse1e2arcs))
   (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta3 (NearestFromPoint ptse1e2arcs pta2))
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_tan" pta1 "_tan" pta2 "_tan" pta3)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (entdel ci)
       (vl-cmdf "_.circle" "2P" "_tan" pta1 "_tan" pta2)
       )
   )
   (setvar 'aperture app)
   (setvar 'osmode osm)
   (princ)
)

Best, regards M.R. (you can now use this final code for perfect results - just press ENTER on segmentation level )

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

!!!!!!!!!!!!!circumpline.dwg

[marko_ribar]

Here is my final result with selecting multiple plines... Saw that Lee posted this on http://www.theswamp.org

 

(vl-load-com) (princ)

;;;"By Lee Mac, sourced from www.lee-mac.com/groupbynum.html";;;
(defun LM:GetIntersections ( obj1 obj2 )
 (LM:GroupByNum (vlax-invoke obj1 'IntersectWith obj2 acExtendNone) 3)
)

(defun LM:GroupByNum ( l n / r)
 (if l
   (cons
     (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
     (LM:GroupByNum l n)
   )
 )
)

(defun interse1e2 ( e1 e2 / lst )
 (if (and e1 e2)
   (setq lst (LM:GetIntersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
 )
 lst
)

;; Minimum Enclosing Circle  -  Lee Mac
;; Implements the algorithm by Pr.Chrystal (1885) using the Convex Hull
;; to determine the Minimum Enclosing Circle of a point set.

(defun LM:MinEncCircle ( lst / _sub )

   (defun _sub ( p1 p2 l1 / a1 a2 l2 p3 p4 )
       (setq l2 (LM:RemoveWithFuzz (list p1 p2) l1 1e-
             p3 (car l2)
             a1 (LM:GetInsideAngle p1 p3 p2)
       )
       (foreach p4 (cdr l2)
           (if (< (setq a2 (LM:GetInsideAngle p1 p4 p2)) a1)
               (setq p3 p4 a1 a2)
           )
       )
       (cond
           (   (<= (/ pi 2.0) a1)
               (list (mid p1 p2) (/ (distance p1 p2) 2.0))
           )
           (   (vl-some
                   (function
                       (lambda ( a b c )
                           (if (< (/ pi 2.0) (LM:GetInsideAngle a b c)) (_sub a c l1))
                       )
                   )
                   (list p1 p1 p2) (list p2 p3 p1) (list p3 p2 p3)
               )
           )
           (   (LM:3PCircle p1 p2 p3)   )
       )
   )

   ((lambda ( lst ) (_sub (car lst) (cadr lst) lst)) (LM:ConvexHull lst))
)

;; Remove With Fuzz  -  Lee Mac
;; Removes items from a list which are equal to a supplied tolerance

(defun LM:RemoveWithFuzz ( l1 l2 fz )
   (vl-remove-if
       (function
           (lambda ( a )
               (vl-some
                   (function (lambda ( b ) (equal a b fz)))
                   l1
               )
           )
       )
       l2
   )
)

;; Get Inside Angle  -  Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2

(defun LM:GetInsideAngle ( p1 p2 p3 )
   (   (lambda ( a ) (min a (- (+ pi pi) a)))
       (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
   )
)

;; 3-Point Circle  -  Lee Mac
;; Returns the Center and Radius of the Circle defined by
;; the supplied three points.

(defun LM:3PCircle ( p1 p2 p3 / cn m1 m2 )
   (setq m1 (mid p1 p2)
         m2 (mid p2 p3)
   )
   (list
       (setq cn
           (inters
               m1 (polar m1 (+ (angle p1 p2) (/ pi 2.)) 1.0)
               m2 (polar m2 (+ (angle p2 p3) (/ pi 2.)) 1.0)
               nil
           )
       )
       (distance cn p1)
   )
)

;; Midpoint - Lee Mac
;; Returns the midpoint of two points

(defun mid ( a b )
   (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to determine the
;; Convex Hull of a list of points.

(defun LM:ConvexHull ( lst / hul p0 )
   (cond
       (   (< (length lst) 4)
           lst
       )
       (   t
           (setq p0 (car lst))
           (foreach p1 (cdr lst)
               (if (or (< (cadr p1) (cadr p0))
                       (and (equal (cadr p1) (cadr p0) 1e- (< (car p1) (car p0)))
                   )
                   (setq p0 p1)
               )
           )
           (setq lst
               (vl-sort lst
                   (function
                       (lambda ( a b / c d )
                           (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-
                               (< (distance p0 a) (distance p0 b))
                               (< c d)
                           )
                       )
                   )
               )
           )
           (setq hul (list (caddr lst) (cadr lst) (car lst)))
           (foreach pt (cdddr lst)
               (setq hul (cons pt hul))
               (while (and (caddr hul) (LM:Clockwise-p (caddr hul) (cadr hul) pt))
                   (setq hul (cons pt (cddr hul)))
               )
           )
           hul
       )
   )
)

;; 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
   )
)

;; LWPolyline to Point List  -  Lee Mac
;; Returns a list of points describing the supplied LWPolyline

(defun LM:LWPoly->List ( ent n / 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-
               (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 (* n (/ (- 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
)

(defun FurthestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (< d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

(defun NearestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq lst (vl-remove pt lst))
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (> d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

;; Test Function

(defun circumpline ( EN N / APP CI OSM PT PTA1 PTA11 PTA2 PTA22 PTA3 PTL PTSE1E2ARCS TST X )
   (if
       (and en
           (setq lst
               (mapcar
                   (function (lambda ( x ) (trans x 0 en)))
                   (LM:LWPoly->List en n)
               )
           )
           (setq lst (LM:MinEncCircle lst))
       )
       (setq ci 
       (entmakex
           (list
               (cons 0 "CIRCLE")
               (cons 10 (car  lst))
               (cons 40 (- (cadr lst) 1e-9))
               (cons 62 2)
               (assoc 210 (entget en))
           )
       ))
   )
   (setq ptse1e2 (interse1e2 en ci))
   (setq ptse1e2 (acet-list-remove-duplicates ptse1e2 1e-6))
   (setq plpts (mapcar '(lambda (x) (cdr x)) (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en)) ))
   (foreach pt ptse1e2
       (mapcar '(lambda (x) (if (equal (list (car pt) (cadr pt)) x 1e-6) (progn (setq tst (cons T tst)) (setq ptl (cons pt ptl))  ))) plpts)
   )
   (if (and (= (length tst) 2) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq ptse1e2arcs (vl-remove (cadr ptl) ptse1e2arcs))
       (entdel ci)
   (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_end" (cadr ptl) "_tan" (car ptse1e2arcs))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 3))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (entdel ci)
   (vl-cmdf "_.circle" "2P" "_end" (car ptl) "_tan" (car ptse1e2arcs))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 5))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq pta1 (car ptse1e2arcs))
       (setq pta2 (FurthestFromPoint ptse1e2arcs pta1))        
       (entdel ci)
   (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_tan" pta1 "_tan" pta2)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 6))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (setq pta22 (NearestFromPoint ptse1e2arcs pta2))
       (setq ptse1e2arcs (vl-remove pta22 ptse1e2arcs))
   (setq ptse1e2arcs (vl-remove pta1 ptse1e2arcs))
   (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta3 (NearestFromPoint ptse1e2arcs pta2))
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_tan" pta1 "_tan" pta2 "_tan" pta3)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (entdel ci)
       (vl-cmdf "_.circle" "2P" "_tan" pta1 "_tan" pta2)
       )
   )
   (princ)
)

(defun c:circumplines ( / N SS SSNL APP OSM )
   (setq app (getvar 'aperture))
   (setq osm (getvar 'osmode))
   (setvar 'aperture 25)
   (setvar 'osmode 0)
   (while (null ss)
       (prompt "\nSelect LWPOLYLINES")
       (setq ss (ssget '((0 . "LWPOLYLINE")) ))
   )
   (initget 6)
   (setq n (getint "\nInput number for level of segmetation <360> - larger the number (slower), smaller the number (faster) : "))
   (if (null n) (setq n 360))
   (mapcar
       '(lambda ( x / en )
           (setq en (ssname ss x))
           (circumpline en n)
        )
        ((lambda ( x ) (while (<= 0 (setq x (1- x))) (setq ssnl (cons x ssnl)) ))
         (setq x (sslength ss))
        )
   )
   (setvar 'aperture app)
   (setvar 'osmode osm)
   (princ)
)

 

Bye, enjoy, M.R.

[Lee Mac]

Is it possible to enhance further by giving a readout of the resultant diameter.

 

Switch the 'Test Function' (near the bottom) in my earlier attached code with this one:

 

(defun c:test ( / en lst )
   (while
       (progn (setvar 'ERRNO 0) (setq en (car (entsel "\nSelect LWPolyline: ")))
           (cond
               (   (= 7 (getvar 'ERRNO))
                   (princ "\nMissed, try again.")
               )
               (   (eq 'ENAME (type en))
                   (if (not (eq "LWPOLYLINE" (cdr (assoc 0 (entget en)))))
                       (princ "\nInvalid Object Selected.")
                   )
               )
           )
       )
   )
   (if
       (and en
           (setq lst
               (mapcar
                   (function (lambda ( x ) (trans x 0 en)))
                   (LM:LWPoly->List en)
               )
           )
           (setq lst (LM:MinEncCircle lst))
           (princ (strcat "\nDiameter: " (rtos (* 2.0 (cadr lst)))))
       )
       (entmakex
           (list
               (cons 0 "CIRCLE")
               (cons 10 (car  lst))
               (cons 40 (cadr lst))
               (assoc 210 (entget en))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

 

I am unable to decipher the differences and relative merits between the two codes.

 

Me neither... as I say, I saw no need for Marko to modify my earlier code...

[Manila Wolf]

Switch the 'Test Function' (near the bottom) in my earlier attached code with this one:

 

The icing on the cake.

 

I love it. Sincere thanks yet again Lee Mac. I fully appreciate your considerable help here.

 

[Lee Mac]

The icing on the cake.

 

I love it. Sincere thanks yet again Lee Mac. I fully appreciate your considerable help here.

 

 

You're very welcome Manila Wolf

 

I really enjoyed writing the code for this 'challenge'

[marko_ribar]

Forgive me as I didn't saw earlier that MEC can be found exactly and with polygon LWPOLYLINES... So no yellow circle will be made - if so than it isn't 100% precise...

 

I'll attach my *.lsp files so you can use them, but be sure that when you select pline(s) you previously zoomed out so you can see all plines entirely as it will error when picking points with snaps... (It's using (command "_.circle"))

 

M.R.

circumpline-final.lsp

circumplines-all.lsp

circumplines-each.lsp

Edited May 5, 2014 by marko_ribar
now works and for n sided polygon PLINES and in any UCS

[marko_ribar]

Codes updated finally...

 

M.R.

 

Suggested file to download : circumplines-all.lsp

 

Here is code :

 

(vl-load-com) (princ)

;;;"By Lee Mac, sourced from www.lee-mac.com/groupbynum.html";;;
(defun LM:GetIntersections ( obj1 obj2 )
 (LM:GroupByNum (vlax-invoke obj1 'IntersectWith obj2 acExtendNone) 3)
)

(defun LM:GroupByNum ( l n / r)
 (if l
   (cons
     (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
     (LM:GroupByNum l n)
   )
 )
)

(defun interse1e2 ( e1 e2 / lst )
 (if (and e1 e2)
   (setq lst (LM:GetIntersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
 )
 lst
)

;; Minimum Enclosing Circle  -  Lee Mac
;; Implements the algorithm by Pr.Chrystal (1885) using the Convex Hull
;; to determine the Minimum Enclosing Circle of a point set.

(defun LM:MinEncCircle ( lst / _sub )

   (defun _sub ( p1 p2 l1 / a1 a2 l2 p3 p4 )
       (setq l2 (LM:RemoveWithFuzz (list p1 p2) l1 1e-
             p3 (car l2)
             a1 (LM:GetInsideAngle p1 p3 p2)
       )
       (foreach p4 (cdr l2)
           (if (< (setq a2 (LM:GetInsideAngle p1 p4 p2)) a1)
               (setq p3 p4 a1 a2)
           )
       )
       (cond
           (   (<= (/ pi 2.0) a1)
               (list (mid p1 p2) (/ (distance p1 p2) 2.0))
           )
           (   (vl-some
                   (function
                       (lambda ( a b c )
                           (if (< (/ pi 2.0) (LM:GetInsideAngle a b c)) (_sub a c l1))
                       )
                   )
                   (list p1 p1 p2) (list p2 p3 p1) (list p3 p2 p3)
               )
           )
           (   (LM:3PCircle p1 p2 p3)   )
       )
   )

   ((lambda ( lst ) (_sub (car lst) (cadr lst) lst)) (LM:ConvexHull lst))
)

;; Remove With Fuzz  -  Lee Mac
;; Removes items from a list which are equal to a supplied tolerance

(defun LM:RemoveWithFuzz ( l1 l2 fz )
   (vl-remove-if
       (function
           (lambda ( a )
               (vl-some
                   (function (lambda ( b ) (equal a b fz)))
                   l1
               )
           )
       )
       l2
   )
)

;; Get Inside Angle  -  Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2

(defun LM:GetInsideAngle ( p1 p2 p3 )
   (   (lambda ( a ) (min a (- (+ pi pi) a)))
       (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
   )
)

;; 3-Point Circle  -  Lee Mac
;; Returns the Center and Radius of the Circle defined by
;; the supplied three points.

(defun LM:3PCircle ( p1 p2 p3 / cn m1 m2 )
   (setq m1 (mid p1 p2)
         m2 (mid p2 p3)
   )
   (list
       (setq cn
           (inters
               m1 (polar m1 (+ (angle p1 p2) (/ pi 2.)) 1.0)
               m2 (polar m2 (+ (angle p2 p3) (/ pi 2.)) 1.0)
               nil
           )
       )
       (distance cn p1)
   )
)

;; Midpoint - Lee Mac
;; Returns the midpoint of two points

(defun mid ( a b )
   (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to determine the
;; Convex Hull of a list of points.

(defun LM:ConvexHull ( lst / hul p0 )
   (cond
       (   (< (length lst) 4)
           lst
       )
       (   t
           (setq p0 (car lst))
           (foreach p1 (cdr lst)
               (if (or (< (cadr p1) (cadr p0))
                       (and (equal (cadr p1) (cadr p0) 1e- (< (car p1) (car p0)))
                   )
                   (setq p0 p1)
               )
           )
           (setq lst
               (vl-sort lst
                   (function
                       (lambda ( a b / c d )
                           (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-
                               (< (distance p0 a) (distance p0 b))
                               (< c d)
                           )
                       )
                   )
               )
           )
           (setq hul (list (caddr lst) (cadr lst) (car lst)))
           (foreach pt (cdddr lst)
               (setq hul (cons pt hul))
               (while (and (caddr hul) (LM:Clockwise-p (caddr hul) (cadr hul) pt))
                   (setq hul (cons pt (cddr hul)))
               )
           )
           hul
       )
   )
)

;; 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
   )
)

;; LWPolyline to Point List  -  Lee Mac
;; Returns a list of points describing the supplied LWPolyline

(defun LM:LWPoly->List ( ent n / 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-
               (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 (* n (/ (- 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
)

(defun FurthestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (< d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

(defun NearestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq lst (vl-remove pt lst))
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (> d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

(defun unit ( v )
 (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)

(defun mxv ( m v )
 (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun v^v ( u v )
 (list
   (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
   (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
   (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
 )
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
 (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
 (setq ux (unit (mapcar '- p2 p1)))
 (setq uy (unit (mapcar '- p3 p1)))
 
 (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
 (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
 (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
 (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
 (transptucs pt pt1n pt2n pt3n)
)

(defun getwcs3dvertpl ( e / coords ptlst plel ux uy uz )
 (setq coords (vlax-safearray->list (vlax-variant-value (vla-get-coordinates (if (eq (type e) 'ename) (setq e (vlax-ename->vla-object e)) e)))))
 (cond
   ((eq (vla-get-objectname e) "AcDbPolyline")
    (setq ptlst (LM:GroupByNum coords 2)))
   ((eq (vla-get-objectname e) "AcDb2dPolyline")
    (setq ptlst (LM:GroupByNum coords 3)))
   ((eq (vla-get-objectname e) "AcDb3dPolyline")
    (setq ptlst (LM:GroupByNum coords 3)))
 )
 (if (vlax-property-available-p e 'Elevation) (setq plel (vla-get-elevation e)))
 (if plel (setq ptlst (mapcar '(lambda ( x ) (list (car x) (cadr x) plel)) ptlst)))
 (if (vlax-property-available-p e 'Normal) (setq uz (vlax-safearray->list (vlax-variant-value (vla-get-normal e)))))
 (if uz
   (progn
     (if (equal uz '(0.0 0.0 1.0) 1e- (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (equal uz '(0.0 0.0 -1.0) 1e- (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (not (or (equal uz '(0.0 0.0 1.0) 1e- (equal uz '(0.0 0.0 -1.0) 1e-)) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
     (if (not uy) (setq uy (unit (v^v uz ux))))
     (setq ptlst (mapcar '(lambda ( p ) (transptwcs p '(0.0 0.0 0.0) ux uy)) ptlst))
   )
 )
 ptlst
)

;; Test Function

(defun circumpline ( SS N / I EN LST LSTT CI P PTSE1E2 PTSINTS PLPTS PLPTSS PTA1 PTA11 PTA2 PTA22 PTA3 PTL PTSE1E2ARCS TST )
   (if
       (and ss
           (setq i -1)
           (while (setq en (ssname ss (setq i (1+ i))))
               (setq lst
                   (mapcar
                       (function (lambda ( x ) (trans x 0 en)))
                       (LM:LWPoly->List en n)
                   )
               )
               (setq lstt (append lst lstt))
           )
           (setq lstt (LM:MinEncCircle lstt))
       )
       (setq ci 
       (entmakex
           (list
               (cons 0 "CIRCLE")
               (cons 10 (setq p (list (car (car lstt)) (cadr (car lstt)) (cdr (assoc 38 (entget (ssname ss 0)))))))
               (cons 40 (- (cadr lstt) 1e-9))
               (cons 62 2)
               (assoc 210 (entget (ssname ss 0)))
           )
       ))
   )
   (command "_.ucs" "za" '(0.0 0.0 0.0) (trans (cdr (assoc 210 (entget (ssname ss 0)))) 0 1 t))
   (setq i -1)
   (while (setq en (ssname ss (setq i (1+ i))))
       (setq ptse1e2 (vl-catch-all-apply 'interse1e2 (list en ci)))
       (setq ptse1e2 (acet-list-remove-duplicates ptse1e2 1e-4))
       (if ptse1e2 (setq ptsints (append ptse1e2 ptsints)))
       (setq plpts (getwcs3dvertpl en))
       (setq plptss (append plpts plptss))
   )
   (setq ptsints (mapcar '(lambda (x) (trans x 0 1)) ptsints))
   (setq plptss (mapcar '(lambda (x) (trans x 0 1)) plptss))
   (foreach pt ptsints
       (mapcar '(lambda (x) (if (equal pt x 1e-6) (progn (setq tst (cons T tst)) (setq ptl (cons pt ptl))  ))) plptss)
   )
   (if (>= (length tst) 3)
       (progn
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_end" (cadr ptl) "_end" (caddr ptl))
       )
   )
   (if (and (= (length tst) 2) (= (length ptse1e2) 2))
       (progn
       (entdel ci)
       (vl-cmdf "_.circle" (trans p en 1) "_end" (car ptl))
       )
   )
   (if (and (= (length tst) 2) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq ptse1e2arcs (vl-remove (cadr ptl) ptse1e2arcs))
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_end" (cadr ptl) "_tan" (car ptse1e2arcs))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 3))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (entdel ci)
       (vl-cmdf "_.circle" (trans p en 1) "_end" (car ptl))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 5))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq pta1 (car ptse1e2arcs))
       (setq pta2 (FurthestFromPoint ptse1e2arcs pta1))        
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_tan" pta1 "_tan" pta2)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 6))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (setq pta22 (NearestFromPoint ptse1e2arcs pta2))
       (setq ptse1e2arcs (vl-remove pta22 ptse1e2arcs))
       (setq ptse1e2arcs (vl-remove pta1 ptse1e2arcs))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta3 (NearestFromPoint ptse1e2arcs pta2))
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_tan" pta1 "_tan" pta2 "_tan" pta3)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (entdel ci)
       (vl-cmdf "_.circle" (trans p en 1) "_tan" pta1)
       )
   )
   (command "_.ucs" "p")
   (princ)
)

(defun c:circumplines ( / N SS APP OSM )
   (setq app (getvar 'aperture))
   (setq osm (getvar 'osmode))
   (setvar 'aperture 25)
   (setvar 'osmode 0)
   (while (null ss)
       (prompt "\nSelect LWPOLYLINES")
       (setq ss (ssget '((0 . "LWPOLYLINE")) ))
   )
   (initget 6)
   (setq n (getint "\nInput number for level of segmetation <360> - larger the number (slower), smaller the number (faster) : "))
   (if (null n) (setq n 360))
   (circumpline ss n)
   (setvar 'aperture app)
   (setvar 'osmode osm)
   (princ)
)

M.R.

Edited May 5, 2014 by marko_ribar

[marko_ribar]

Routines had some lack, now fixed - it should work in all UCS, just check that its zoomed out and that all plines belong to the same plane - (if used circumplines-all.lsp)...

 

M.R.

[JensiLehmanni]

 

On 5/17/2013 at 11:33 AM, marko_ribar said:

Codes updated finally...

 

M.R.

 

Suggested file to download : circumplines-all.lsp

 

Here is code :

 

 

(vl-load-com) (princ)

;;;"By Lee Mac, sourced from www.lee-mac.com/groupbynum.html";;;
(defun LM:GetIntersections ( obj1 obj2 )
 (LM:GroupByNum (vlax-invoke obj1 'IntersectWith obj2 acExtendNone) 3)
)

(defun LM:GroupByNum ( l n / r)
 (if l
   (cons
     (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
     (LM:GroupByNum l n)
   )
 )
)

(defun interse1e2 ( e1 e2 / lst )
 (if (and e1 e2)
   (setq lst (LM:GetIntersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
 )
 lst
)

;; Minimum Enclosing Circle  -  Lee Mac
;; Implements the algorithm by Pr.Chrystal (1885) using the Convex Hull
;; to determine the Minimum Enclosing Circle of a point set.

(defun LM:MinEncCircle ( lst / _sub )

   (defun _sub ( p1 p2 l1 / a1 a2 l2 p3 p4 )
       (setq l2 (LM:RemoveWithFuzz (list p1 p2) l1 1e-
             p3 (car l2)
             a1 (LM:GetInsideAngle p1 p3 p2)
       )
       (foreach p4 (cdr l2)
           (if (< (setq a2 (LM:GetInsideAngle p1 p4 p2)) a1)
               (setq p3 p4 a1 a2)
           )
       )
       (cond
           (   (<= (/ pi 2.0) a1)
               (list (mid p1 p2) (/ (distance p1 p2) 2.0))
           )
           (   (vl-some
                   (function
                       (lambda ( a b c )
                           (if (< (/ pi 2.0) (LM:GetInsideAngle a b c)) (_sub a c l1))
                       )
                   )
                   (list p1 p1 p2) (list p2 p3 p1) (list p3 p2 p3)
               )
           )
           (   (LM:3PCircle p1 p2 p3)   )
       )
   )

   ((lambda ( lst ) (_sub (car lst) (cadr lst) lst)) (LM:ConvexHull lst))
)

;; Remove With Fuzz  -  Lee Mac
;; Removes items from a list which are equal to a supplied tolerance

(defun LM:RemoveWithFuzz ( l1 l2 fz )
   (vl-remove-if
       (function
           (lambda ( a )
               (vl-some
                   (function (lambda ( b ) (equal a b fz)))
                   l1
               )
           )
       )
       l2
   )
)

;; Get Inside Angle  -  Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2

(defun LM:GetInsideAngle ( p1 p2 p3 )
   (   (lambda ( a ) (min a (- (+ pi pi) a)))
       (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
   )
)

;; 3-Point Circle  -  Lee Mac
;; Returns the Center and Radius of the Circle defined by
;; the supplied three points.

(defun LM:3PCircle ( p1 p2 p3 / cn m1 m2 )
   (setq m1 (mid p1 p2)
         m2 (mid p2 p3)
   )
   (list
       (setq cn
           (inters
               m1 (polar m1 (+ (angle p1 p2) (/ pi 2.)) 1.0)
               m2 (polar m2 (+ (angle p2 p3) (/ pi 2.)) 1.0)
               nil
           )
       )
       (distance cn p1)
   )
)

;; Midpoint - Lee Mac
;; Returns the midpoint of two points

(defun mid ( a b )
   (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to determine the
;; Convex Hull of a list of points.

(defun LM:ConvexHull ( lst / hul p0 )
   (cond
       (   (< (length lst) 4)
           lst
       )
       (   t
           (setq p0 (car lst))
           (foreach p1 (cdr lst)
               (if (or (< (cadr p1) (cadr p0))
                       (and (equal (cadr p1) (cadr p0) 1e- (< (car p1) (car p0)))
                   )
                   (setq p0 p1)
               )
           )
           (setq lst
               (vl-sort lst
                   (function
                       (lambda ( a b / c d )
                           (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-
                               (< (distance p0 a) (distance p0 b))
                               (< c d)
                           )
                       )
                   )
               )
           )
           (setq hul (list (caddr lst) (cadr lst) (car lst)))
           (foreach pt (cdddr lst)
               (setq hul (cons pt hul))
               (while (and (caddr hul) (LM:Clockwise-p (caddr hul) (cadr hul) pt))
                   (setq hul (cons pt (cddr hul)))
               )
           )
           hul
       )
   )
)

;; 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
   )
)

;; LWPolyline to Point List  -  Lee Mac
;; Returns a list of points describing the supplied LWPolyline

(defun LM:LWPoly->List ( ent n / 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-
               (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 (* n (/ (- 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
)

(defun FurthestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (< d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

(defun NearestFromPoint ( lst pt / d1 d2 p1 p2 )
   (setq lst (vl-remove pt lst))
   (setq d1 (distance pt (car lst))
         p1 (car lst)
   )
   (foreach p2 (cdr lst)
       (if (> d1 (setq d2 (distance pt p2)))
           (setq d1 d2 p1 p2)
       )
   )
   p1
)

(defun unit ( v )
 (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)

(defun mxv ( m v )
 (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun v^v ( u v )
 (list
   (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
   (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
   (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
 )
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
 (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
 (setq ux (unit (mapcar '- p2 p1)))
 (setq uy (unit (mapcar '- p3 p1)))
 
 (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
 (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
 (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
 (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
 (transptucs pt pt1n pt2n pt3n)
)

(defun getwcs3dvertpl ( e / coords ptlst plel ux uy uz )
 (setq coords (vlax-safearray->list (vlax-variant-value (vla-get-coordinates (if (eq (type e) 'ename) (setq e (vlax-ename->vla-object e)) e)))))
 (cond
   ((eq (vla-get-objectname e) "AcDbPolyline")
    (setq ptlst (LM:GroupByNum coords 2)))
   ((eq (vla-get-objectname e) "AcDb2dPolyline")
    (setq ptlst (LM:GroupByNum coords 3)))
   ((eq (vla-get-objectname e) "AcDb3dPolyline")
    (setq ptlst (LM:GroupByNum coords 3)))
 )
 (if (vlax-property-available-p e 'Elevation) (setq plel (vla-get-elevation e)))
 (if plel (setq ptlst (mapcar '(lambda ( x ) (list (car x) (cadr x) plel)) ptlst)))
 (if (vlax-property-available-p e 'Normal) (setq uz (vlax-safearray->list (vlax-variant-value (vla-get-normal e)))))
 (if uz
   (progn
     (if (equal uz '(0.0 0.0 1.0) 1e- (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (equal uz '(0.0 0.0 -1.0) 1e- (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (not (or (equal uz '(0.0 0.0 1.0) 1e- (equal uz '(0.0 0.0 -1.0) 1e-)) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
     (if (not uy) (setq uy (unit (v^v uz ux))))
     (setq ptlst (mapcar '(lambda ( p ) (transptwcs p '(0.0 0.0 0.0) ux uy)) ptlst))
   )
 )
 ptlst
)

;; Test Function

(defun circumpline ( SS N / I EN LST LSTT CI P PTSE1E2 PTSINTS PLPTS PLPTSS PTA1 PTA11 PTA2 PTA22 PTA3 PTL PTSE1E2ARCS TST )
   (if
       (and ss
           (setq i -1)
           (while (setq en (ssname ss (setq i (1+ i))))
               (setq lst
                   (mapcar
                       (function (lambda ( x ) (trans x 0 en)))
                       (LM:LWPoly->List en n)
                   )
               )
               (setq lstt (append lst lstt))
           )
           (setq lstt (LM:MinEncCircle lstt))
       )
       (setq ci 
       (entmakex
           (list
               (cons 0 "CIRCLE")
               (cons 10 (setq p (list (car (car lstt)) (cadr (car lstt)) (cdr (assoc 38 (entget (ssname ss 0)))))))
               (cons 40 (- (cadr lstt) 1e-9))
               (cons 62 2)
               (assoc 210 (entget (ssname ss 0)))
           )
       ))
   )
   (command "_.ucs" "za" '(0.0 0.0 0.0) (trans (cdr (assoc 210 (entget (ssname ss 0)))) 0 1 t))
   (setq i -1)
   (while (setq en (ssname ss (setq i (1+ i))))
       (setq ptse1e2 (vl-catch-all-apply 'interse1e2 (list en ci)))
       (setq ptse1e2 (acet-list-remove-duplicates ptse1e2 1e-4))
       (if ptse1e2 (setq ptsints (append ptse1e2 ptsints)))
       (setq plpts (getwcs3dvertpl en))
       (setq plptss (append plpts plptss))
   )
   (setq ptsints (mapcar '(lambda (x) (trans x 0 1)) ptsints))
   (setq plptss (mapcar '(lambda (x) (trans x 0 1)) plptss))
   (foreach pt ptsints
       (mapcar '(lambda (x) (if (equal pt x 1e-6) (progn (setq tst (cons T tst)) (setq ptl (cons pt ptl))  ))) plptss)
   )
   (if (>= (length tst) 3)
       (progn
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_end" (cadr ptl) "_end" (caddr ptl))
       )
   )
   (if (and (= (length tst) 2) (= (length ptse1e2) 2))
       (progn
       (entdel ci)
       (vl-cmdf "_.circle" (trans p en 1) "_end" (car ptl))
       )
   )
   (if (and (= (length tst) 2) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq ptse1e2arcs (vl-remove (cadr ptl) ptse1e2arcs))
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_end" (cadr ptl) "_tan" (car ptse1e2arcs))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 3))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (entdel ci)
       (vl-cmdf "_.circle" (trans p en 1) "_end" (car ptl))
       )
   )
   (if (and (= (length tst) 1) (= (length ptse1e2) 5))
       (progn
       (setq ptse1e2arcs (vl-remove (car ptl) ptse1e2))
       (setq pta1 (car ptse1e2arcs))
       (setq pta2 (FurthestFromPoint ptse1e2arcs pta1))        
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_end" (car ptl) "_tan" pta1 "_tan" pta2)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 6))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (setq pta22 (NearestFromPoint ptse1e2arcs pta2))
       (setq ptse1e2arcs (vl-remove pta22 ptse1e2arcs))
       (setq ptse1e2arcs (vl-remove pta1 ptse1e2arcs))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta3 (NearestFromPoint ptse1e2arcs pta2))
       (entdel ci)
       (vl-cmdf "_.circle" "3P" "_tan" pta1 "_tan" pta2 "_tan" pta3)
       )
   )
   (if (and (null tst) (= (length ptse1e2) 4))
       (progn
       (setq ptse1e2arcs ptse1e2)
       (setq pta1 (car ptse1e2arcs))
       (setq pta11 (NearestFromPoint ptse1e2arcs pta1))
       (setq ptse1e2arcs (vl-remove pta11 ptse1e2arcs))
       (setq pta2 (NearestFromPoint ptse1e2arcs pta1))
       (entdel ci)
       (vl-cmdf "_.circle" (trans p en 1) "_tan" pta1)
       )
   )
   (command "_.ucs" "p")
   (princ)
)

(defun c:circumplines ( / N SS APP OSM )
   (setq app (getvar 'aperture))
   (setq osm (getvar 'osmode))
   (setvar 'aperture 25)
   (setvar 'osmode 0)
   (while (null ss)
       (prompt "\nSelect LWPOLYLINES")
       (setq ss (ssget '((0 . "LWPOLYLINE")) ))
   )
   (initget 6)
   (setq n (getint "\nInput number for level of segmetation <360> - larger the number (slower), smaller the number (faster) : "))
   (if (null n) (setq n 360))
   (circumpline ss n)
   (setvar 'aperture app)
   (setvar 'osmode osm)
   (princ)
)

 

M.R.

Hey everyone,

 

im very new to lisp routines, and trying to get my head around for hours on how to execute this command on each object selected. Unfortunately the "circumplines-each.lsp" does only produce one circle per object per execution. Is there a fast solution to batch excute this command on every object selected?

 

Regards

 

Jens

[marko_ribar]

This was long time ago...

Still, I've looked at my library, and found related things for MinEncCircle(s)...

 

Have look at this ZIP - I think that you're looking for version with "circumplines-all.lsp"... I've packed all that I could think you may need/like residing enclosing circles/spheres...

 

Regards, M.R.

min-max-enc-plines-spheres.zip

[GarenGui]

Does anyone know how to run this on a specific region? I'd love to show you how the code will be used, in this case to optimize the calculation of minimum extrusion tool diameters in our engineering drawings inside the dwg summary info and custom properties, also to make easier for future integrations in erp softwares. This will help us to develop and implemented the code through a company network plugin at a leading global mining and aluminum extrusion company. Your help is greatly appreciated, as always!

Edited July 19 by GarenGui