Topic: [Challenge] Intersection of line & circle

[chlh_jd]

Intersection of line & circle in plane
line : p1 p2
circle : cen rad
(fun p1 p2 cen rad)

Here's your most efficient codes  

[ElpanovEvgeniy]

check only one plane?

[chlh_jd]

Hi ElpanovEvgeniy
I'm sorry to forget the cond 'just plane'

[qjchen]

Here is my code and testing code. for study a little about trans.

It add a parameter at the end, realint? if nil then virtural intersection will be allowed

The code can be used in 3d ucs plane.

But it is too long code, I will try to shorten it.

Code: [Select]

;;;by qjchen@gmail.com
;;;;vec plus constant
(defun q:vec:*c(v a)  (mapcar '(lambda(x) (* x a)) v))
;;;;vec dot product
(defun q:vec:dot*(v1 v2)  (apply '+ (mapcar '* v1 v2)))
;;;;Normalize a vec
(defun q:vec:Norm(v / l) (if (not (zerop (setq l (distance '(0 0 0) v)))) (mapcar '(lambda(x) (/ x l)) v)))
;;;; Intersection of line and circle
;;;; qjchen@gmail.com
(defun q:geo:line-int-cir1(p1 p2 c r realint? / n pv f d2)
 (setq n (q:vec:Norm (mapcar '- p2 p1)))
 (setq pv (mapcar '+ p1 (q:vec:*c n (q:vec:dot* (mapcar '- c p1) n))))
 (defun f(p p1 p2 n) (if (< (* (- (caddr (trans p 0 n)) (caddr (trans p1 0 n))) (- (caddr (trans p 0 n)) (caddr (trans p2 0 n)))) 0.0) p))
 (if (< (setq d2 (- (expt r 2.) (expt (distance c pv) 2.))) 0.)
   (list nil nil)
   (if realint?
    (list (f (mapcar '+ pv (q:vec:*c n (sqrt d2))) p1 p2 n) (f (mapcar '- pv (q:vec:*c n (sqrt d2))) p1 p2 n))
    (list (mapcar '+ pv (q:vec:*c n (sqrt d2))) (mapcar '- pv (q:vec:*c n (sqrt d2))))
   )
 )
)
;;;;for test
(defun c:test( / c p1 p2 r res)
  (setq p1 (getpoint "1st point\n") p2 (getpoint "2nd point\n") c (getpoint "3rd point\n") r (getdist "distan\n"))
  (setq res (q:geo:line-int-cir1 p1 p2 c r T))
  (if (car res) (grdraw (list 0 0 0) (car res) 1) )
  (if (cadr res) (grdraw (list 0 0 0) (cadr res) 2))
)


[Lee Mac]

I have this, but it considers the Line infinite in length... I'm sure there's a better way

Code: [Select]

(defun IntersLineCircle ( p1 p2 c r  / p d v )

  (setq p (ProjectPointonLine c p1 p2)
        d (distance c p)
        v (v1 (mapcar '- p2 p1))
  )

  (cond
    ( (> d r) nil )
   
    ( (equal d r 1e-8) (list p) )
   
    ( (setq v (vxs v (sqrt (- (* r r) (* d d)))))
     
      (list (mapcar '+ p v) (mapcar '- p v))
    )
  )
)

(defun ProjectPointonLine ( pt p1 p2 )
  (
    (lambda ( n )
      (setq pt (trans pt 0 n))
      (trans (list (car pt) (cadr pt) (caddr (trans p1 0 n))) n 0)
    )
    (v^v
      (mapcar '- p2 p1)
      (mapcar '- (mapcar '+ p1 (v^v (mapcar '- p2 p1) (mapcar '- pt p1))) p1)
    )
  )
)

(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 vxs ( v s )
  (mapcar '(lambda ( n ) (* n s)) v)
)

(defun v1 ( v )
  ( (lambda ( n ) (if (not (equal n 0.0 1e-14)) (vxs v (/ 1.0 n))))
    (distance '(0. 0. 0.) v)
  )
)


Test function:

Code: [Select]

(defun c:test ( / _p p1 p2 c r )

  (defun _p ( p ) (entmakex (list (cons 0 "POINT") (cons 10 p))))

  (if
    (and
      (setq p1 (getpoint "\nLine Start: "))
      (setq p2 (getpoint "\nLine End: "))
      (setq c  (getpoint "\nCircle Center: "))
      (setq r  (getdist c "\nCircle Radius: "))
    )
    (mapcar '_p (IntersLineCircle (trans p1 1 0) (trans p2 1 0) (trans c 1 0) r))
  )

  (princ)
)

[Lee Mac]

I think I got hooked on that trans method a bit too much...

Code: [Select]

(defun IntersLineCircle ( p1 p2 c r onseg  / p d v )

  (setq v (v1 (mapcar '- p2 p1)) p (mapcar '+ p1 (vxs v (vxv (mapcar '- c p1) v)))
        d (distance c p)
  )

  (cond
    ( (> d r) nil )
   
    ( (equal d r 1e-8) (list (inters p1 p2 c p onseg)))
   
    ( (setq v (vxs v (sqrt (- (* r r) (* d d)))))

      (list
        (inters p1 p2 c (mapcar '+ p v) onseg)
        (inters p1 p2 c (mapcar '- p v) onseg)
      )
    )
  )
)

(defun v1 ( v )
  ( (lambda ( n ) (if (not (equal n 0.0 1e-14)) (vxs v (/ 1.0 n))))
    (distance '(0. 0. 0.) v)
  )
)

(defun vxv ( u v ) (apply '+ (mapcar '* u v)))

(defun vxs ( v s ) (mapcar '(lambda ( n ) (* n s)) v))

[qjchen]

Lee, we use almost the same method~

but your

(inters p1 p2 c (mapcar '+ p v) onseg)

is better than mine.
I use a self define function f to judge it, I should have use inters instead:)

And it should be

Code: [Select]

;;;after lee mac's good method
(defun q:geo:line-int-cir2(p1 p2 c r realint? / n pv d2)
 (setq n (q:vec:Norm (mapcar '- p2 p1))
       pv (mapcar '+ p1 (q:vec:*c n (q:vec:dot* (mapcar '- c p1) n))))
 (if (< (setq d2 (- (expt r 2.) (expt (distance c pv) 2.))) 0.)
   (list nil nil)
   (list (inters p1 p2 c (mapcar '+ pv (q:vec:*c n (sqrt d2))) realint?)(inters p1 p2 c (mapcar '- pv (q:vec:*c n (sqrt d2))) realint?))
 )
)


[Lee Mac]

Lee, we use almost the same method~

 

With my first code I overlooked the easier method of using the dot product to project the circle center onto the line, as, from that other thread I could only think about using trans and ended up constructing a plane perpendicular to the line/circle... 

[Lee Mac]

Of course, there is the lazy-man's method 

Code: [Select]

(defun IntersLineCircle ( p1 p2 c r onseg / return e1 e2 ) (vl-load-com)
  (setq return
    (LM:GroupByNum
      (vlax-invoke
        (vlax-ename->vla-object
          (setq e1 (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))
        )
        'IntersectWith
        (vlax-ename->vla-object
          (setq e2 (entmakex (list (cons 0 "CIRCLE") (cons 10 c) (cons 40 r))))
        )
        (if onseg acExtendNone acExtendthisEntity)
      )
      3
    )
  )
  (mapcar 'entdel (list e1 e2))
  return
)

;;-----------------=={ Group by Number }==--------------------;;
;;                                                            ;;
;;  Groups a list into a list of lists, each of length 'n'    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  l - List to process                                       ;;
;;  n - Number of elements by which to group the list         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of lists, each of length 'n'               ;;
;;------------------------------------------------------------;;

(defun LM:GroupByNum ( l n / r)
  ;; © Lee Mac 2010
  (if l
    (cons
      (reverse
        (repeat n (setq r (cons (car l) r) l (cdr l)) r)
      )
      (LM:GroupByNum l n)
    )
  )
)

[qjchen]

Of course, there is the lazy-man's method 

But certainly if the curve is more complicate, this is the best method in Autolisp.

[Lee Mac]

But certainly if the curve is more complicate, this is the best method in Autolisp.

It's certainly more practical. 

[chlh_jd]

Hi qjchen , Hi Lee Mac 
I learn a lot from your codes through Vetor Method

Here's my first code

Code: [Select]

;;;Through general Geometric convertion
(defun LIC (pt1 pt2 cen rad / pt dis ang d)
  (setq pt  (inters
      cen
      (polar cen (+ (/ pi 2.) (angle pt1 pt2)) 1.)
      pt1
      pt2
      nil
    )
dis (distance pt cen)
  )
  (cond
    ((equal rad dis) (list pt))
    ((> rad dis)
     (list (polar pt
  (setq ang (angle pt1 pt2))
  (setq d (sqrt (- (* rad rad) (* dis dis))))
   )
   (polar pt
  (+ pi ang)
  d
   )
     )
    )   
  )
)

I try to use the 'intersectwith method , But it run so slow

Code: [Select]

;;;Through 'intersectwith
;;;To get intersection of two curves
;;;____0  non EX ,1 first EX  2 second EX ,3 both EX___________________
;;;________BY__GSLS(SS)_______________2010.08.05_____________________
(defun ss-interpts (e1 e2 lim / obj1 obj2 mid end mid1)
  (setq obj1 (vlax-ename->vla-object e1)
obj2 (vlax-ename->vla-object e2)
  )
  (setq mid (vla-IntersectWith obj1 obj2 lim))
  (vlax-release-object obj1)
  (vlax-release-object obj2)
  (if (not
(minusp
  (vlax-safearray-get-u-bound (vlax-variant-value mid) 1)
)
      )
    (progn
      (setq mid (vlax-safearray->list (vlax-variant-value mid)))
      (setq end nil)
      (repeat (/ (length mid) 3)
(setq mid1 (list (car mid) (cadr mid) (caddr mid))
      mid  (cdddr mid)
      end  (cons mid1 end)
)
      )
      (reverse end)
    )
    nil
  )
)
;;;use the intersectwith , But it sacrifices a lot of efficiency
(defun LICa (pt1 pt2 cen rad / en1 en2 pts)
  (setq en1 (entmakex (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2)))
en2 (entmakex (list (cons 0 "CIRCLE") (cons 10 cen) (cons 40 rad)))
)
  (setq pts (ss-interpts en1 en2 3))
  (entdel en1)(entdel en2)
  pts
  )

Fun for test

Code: [Select]

;;;test
(defun c:test(/ en1 en2 pt1 pt2 cen rad pts)
  (setq en1 (car (entsel "Select a Line :"))
en2 (car (entsel "\nSelect a Circle :"))
pt1 (cdr (assoc 10 (entget en1)))
pt2 (cdr (assoc 11 (entget en1)))
cen (cdr (assoc 10 (entget en2)))
rad (cdr (assoc 40 (entget en2)))
)
  (setq pts (LIC pt1 pt2 cen rad))
  (check-pt pts)
  (princ)
  )
;;;Auxiliary Function to  Check the Point Set
(defun check-pt (ptlst / i)
  (setq i 0)
  (mapcar (function
    (lambda (x)
      (entmake
(list (cons 0 "LINE") (cons 10 (list 0 0 0)) (cons 11 x) (cons 62 (setq i (1+ i))))
      )
    )
  )
  ptlst
  )
)


[chlh_jd]

Hi Lee Mac
(mapcar '- (mapcar '+ p1 (v^v (mapcar '- p2 p1) (mapcar '- pt p1))) p1)

I can't understand , this Statement not equal

Code: [Select]

(v^v (mapcar '- p2 p1) (mapcar '- pt p1)) ?

[chlh_jd]

Another way : Use trigonometric funs and polar coors

But it's less than use vectors,I'm not sure It can be rewrited into 'trans method ?

Code: [Select]

(defun LICb (pt1 pt2 cen rad / ang p1 p2 anl x y d anp anq pts)
  (setq ang (angle '(0 0 0) cen)
p1  (gsls-xy->ab pt1 cen ang)
p2  (gsls-xy->ab pt2 cen ang)
anl (- (angle pt1 pt2) ang)
  )
  (while (> anl pi)
    (setq anl (- anl pi))
  )
  (setq x (car (inters '(0 0 0) (list rad 0 0) p1 p2 nil))
y (cadr (inters '(0 0 0) (list 0 rad 0) p1 p2 nil))
d (/ (* x y) (sqrt (+ (* x x) (* y y))))
  )
  (cond ((equal d rad 1e-8)
(if (>= x 0)
  (setq anp (- anl (/ pi 2.)))
  (setq anp (+ anl (/ pi 2.)))
)
(setq pts (list (list (* rad (cos anp)) (* rad (sin anp)) 0)))
)
((< d rad)
(if (>= x 0)
  (setq anp (+ (atan (* (sqrt (- 1. (* (/ d rad) (/ d rad)))) (/ rad d)))
  anl
  (/ pi -2.)
)
anq (- (* 2. anl) anp pi)
  )
  (setq anp (+ (atan (* (sqrt (- 1. (* (/ d rad) (/ d rad)))) (/ rad d)))
  anl
  (/ pi 2.)
)
anq (- (* 2. anl) anp pi)
  )
)
(setq pts (list (list (* rad (cos anp)) (* rad (sin anp)) 0)
(list (* rad (cos anq)) (* rad (sin anq)) 0)
  )
)
)
  )
  (if pts
    (mapcar (function (lambda (p)
(gsls-ab->xy p cen ang)
     )
   )
   pts
    )
  )
)
Use Fun

Code: [Select]

;;;trans UCS 2Dcoors into wcs，the UCS which orrgin on PT0，X-aixs angle is ANG
;;;X=X0+AcosR0-BsinR0
;;;Y=Y0+AsinR0+BcosR0
(defun gsls-AB->XY (pt pt0 ANG / X Y)
  (setq X (+ (car pt0)
    (* (car pt) (cos ANG))
    (* -1 (cadr pt) (sin ANG))
 )
Y (+ (cadr pt0)
    (* (car pt) (sin ANG))
    (* (cadr pt) (cos ANG))
 )
  )
  (list X Y 0.0)
)
;;;trans wcs 2Dcoors into ucs，the UCS which orrgin on PT0，X-aixs angle is ANG
;;;A=(X-X0)cosR0+(Y-Y0)sinR0
;;;B=(Y-Y0)cosR0-(X-X0)sinR0
(defun gsls-XY->AB (pt pt0 ANG / A B)
  (setq A (+ (* (- (car pt) (car pt0)) (cos ANG))
    (* (- (cadr pt) (cadr pt0)) (sin ANG))
 )
B (- (* (- (cadr pt) (cadr pt0)) (cos ANG))
    (* (- (car pt) (car pt0)) (sin ANG))
 )
  )
  (list A B 0.0)
)


[Lee Mac]

Hi Lee Mac
(mapcar '- (mapcar '+ p1 (v^v (mapcar '- p2 p1) (mapcar '- pt p1))) p1)

I can't understand , this Statement not equal

Code: [Select]

(v^v (mapcar '- p2 p1) (mapcar '- pt p1)) ?

Indeed it is    The method in my first code is laughable...