Topic: [Challenge] Intersection of line & circle

[qjchen]

The following is my code about intersection of circle and circle.
I hope you like it

Code: [Select]

;;;;;;;by qjchen@gmail.com
(defun q:geo:circle-int-circle(p1 r1 p2 r2 / n d a h)
 (setq n (mapcar '- p2 p1) d (distance p1 p2))
 (setq p1 (trans p1 0 n))
 (cond (((lambda(a b c) (and (> a 0.)(> b 0.)(> c 0.)(> (+ a b) c)(> (+ b c) a)(> (+ c a) b))) d r1 r2)
        (setq a (/ (+ (* r1 r1) (* d d) (* -1. r2 r2)) 2. d))
        (setq h (sqrt (- (* r1 r1) (* a a))))
        (list (trans (list (+ (car p1) h) 0. (+ (caddr p1) a)) n 0)
              (trans (list (- (car p1) h) 0. (+ (caddr p1) a)) n 0)
        )
        )
  )
)


Code: [Select]

(defun c:test (/ p1 p2 r1 r2 res)
  (setq p1 (getpoint "p1:\n")
        p2 (getpoint "p2\n")
        r1 (getdist "r1\n")
        r2 (getdist "r2\n")
  )
  (setq res (q:geo:circle-int-circle p1 r1 p2 r2))
  (if (car res)
    (grdraw (list 0 0 0) (car res) 1)
  )
  (if (cadr res)
    (grdraw (list 0 0 0) (cadr res) 2)
  )
)



[Lee Mac]

Nice method Chen 

[qjchen]

Thank you Lee for a nice picture illustration~

Recently I am amazed by the method of vector and the 'trans'

I am trying to write more about space geometry.

[chlh_jd]

Good Idea qj-chen , thanks!
Needed peture for me to understand qj-chen's function , thanks Lee Mac

I just understand the fun 'trans' a lit ,  More advice Please 
there change my coor-trans function : GSLS-XY->AB & GSLS-AB-XY , when the cont eq 1 , it run eq GSLS-XY-AB.

Code: [Select]

;;; function : mytrans
;;; arg :
;;; pt0 - UCS coordinate origin in wcs
;;; ang - X-Axis angle by UCS with WCS , or second point coord on X-Axis in WCS
;;; pt - point list which in UCS or WCS
;;; cont - control para , if it's 1 then return pt from WCS to UCS , eles return pt from UCS to WCS
;;; by GSLS(SS), 2011-2-1
(defun mytrans (pt pt0 ang cont / n)
  (cond ((and pt pt0 ang (listp pt) (listp pt0) (numberp ang))
(setq n (list (cos ang) (sin ang) 0.0))
)
((and pt pt0 ang (listp pt) (listp pt0) (listp ang))
(setq n (mapcar '- ang pt0))
)
(t nil)
  )
  (if (and n (>= 3 (length pt) 2) (>= 3 (length pt0) 2))
    (progn
      (if (null (caddr pt))
(setq pt (append pt (list 0.0)))
      )
      (if (null (caddr pt0))
(setq pt0 (append pt0 (list 0.0)))
      )
      (if (= cont 1)
(reversen (trans (mapcar '- pt pt0) 0 n) 2)
(mapcar '+ pt0 (trans (reversen pt 1) n 0))
   
)
    )
    (alert "error: Para type error ")
  )
)
;;;reverse list by times in order
(defun reversen (lst n)
  (cond ((<= (setq n (rem n (length lst))) 0)
lst
)
(t
(reversen (append (cdr lst) (list (car lst))) (1- n))
)
  )
)


[Lee Mac]

I just understand the fun 'trans' a lit ,  More advice Please 

By using trans we are making a change of basis (change of UCS, if you like), using the vector between the circle centers as the normal to the plane in which our basis is defined.

In this way we can manipulate points by changing the X/Y values, whilst viewing the point as if everything is in the XY-plane. When finished manipulating the point, we use trans to transform everything back to the standard basis (or WCS).

Lee

[gile]

Hi,

About trans using in 3d, you can see this topic

[chlh_jd]

Thanks Lee!
Thanks gile!

[CAB]

gile that's such a good post I made it into a sticky. 

[chlh_jd]

Thanks CAB !
Hi All
How can I get the Matrix from the UCS-Origin & angle of UCS  X-Axis or a point of UCS X-Axis ?
If can get the Matrix , I can use the gile's function or others function to trans pt by matrix .

[gile]

Hi,

Thanks CAB, even I think this post is quite confuse due to my poor English...

How can I get the Matrix from the UCS-Origin & angle of UCS  X-Axis or a point of UCS X-Axis ?
If can get the Matrix , I can use the gile's function or others function to trans pt by matrix .

I am not sure to understand what you're asking for, but using Vladimir Nesterovsky's mxv routine and gc:CrossProduct (previously named: v^v) you can build the 3X3 transformation matrix form WCS to the current UCS.

Code: [Select]

;; MXV
;; Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)

;; gc:CrossProduct
;; Returns the cross product of 2 vectors
(defun gc:CrossProduct (v1 v2)
  (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
  )
)
Here're 3 different ways to get this 3X3 matrix, they return the same result:

Code: [Select]

(setq mat (list (getvar 'ucsxdir) (getvar 'ucsydir) (gc:CrossProduct (getvar 'ucsxdir) (getvar 'ucsydir))))

(setq mat (list (getvar 'ucsxdir) (getvar 'ucsydir) (trans '(0. 0. 1.) 1 0 T)))

(setq mat (mapcar '(lambda (x) (trans x 1 0 T)) '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))))
A 3X3 transformation matrix doesn't care about displacement (UCS origin), but this matrix is enough to transform vectors with Vladimir Nesterovsky's mxv:

Code: [Select]

(mxv mat '(10. 20. 30.))returns the same result as:

Code: [Select]

(trans '(10. 20. 30.) 0 1 T)
If you have to transform points, you must take care of the UCS origin and displace the the vector.
These 3 expressions return the same result:

Code: [Select]

(mapcar '- (mxv mat '(10. 20. 30.)) (mxv mat (getvar 'ucsorg)))

(mapcar '+ (mxv mat '(10. 20. 30.)) (trans '(0. 0. 0.) 0 1))

(trans '(10. 20. 30.) 0 1)

[chlh_jd]

Thanks gile 
Before this , I used the following code to get the UCS arg , I write how stupid 

Code: [Select]

;;; ss-getrcsmatrix (only by lisp)
;;; function: to Get the Coordinate transformation Matrix
;;; arg :
;;; lst - RCS coordinate system relative to the WCS coordinates vector
;;; org - when translate RCS to WCS , it's the coordinates of WCS-Origin in UCS
;;;     - when translate WCS to UCS , it's the coordinates of UCS-Origin in WCS
;;; Used cond : drawing Vector must be '(0 0 1)
;;; BY GSLS(SS)
;;; 2010-09-29
(defun ss-getrcsmatrix (lst org / m i j)
  (setq m ([0] 4 4)
m (ch-lst 1.0 (list 3 3) m)
i -1
  )
  (repeat 3
    (setq i (1+ i)
  m (ch-lst (nth i org) (list i 3) m)
  j -1
    )
    (repeat 3
      (setq j (1+ j))
      (setq m (ch-lst (nth i (nth j lst)) (list i j) m))
    )
  )
)
;;; ss-getucsarg
;;;function: To get the parameter of the Current
;;;return the list '(is-in-UCS trans-matrix)
(defun ss-getucsarg (/       UcsFlag  xdir ydir zdir
     origin   WcsOrg   matlst matrix revmat
    )
  (setq UcsFlag (getvar "WORLDUCS"))
  (if (= UcsFlag 0)
    (setq UcsFlag T
  xdir   (getvar "UCSXDIR")
  ydir   (getvar "UCSYDIR")
  zdir   (gile-CrossProduct xdir ydir)
  origin  (getvar "UCSORG")
  WcsOrg  (trans '(0 0 0) 0 1)
  matLst  (list xdir ydir zdir)
  matrix  (ss-getrcsmatrix matLst origin)
    )
    (setq UcsFlag nil)
  )
  (list UcsFlag matrix)
)
;;;Create a n-dim zero-vector
(defun [0 (n / lst)
  (repeat n
    (setq lst (cons 0.0 lst))
  )
)
;;;Create a m*n Zero-Matrix
(defun [0] (m n / a lst)
  (setq a ([0 n))
  (repeat m
    (setq lst (cons a lst))
  )
)
;;;written by qj-chen
;;;Edited by GSLS(SS)
(defun ch-lst (new i lst / j len fst mid)
  (if (/= (type i) 'list)
    (cond
      ((minusp i)
       lst
      )
      ((> i (setq len (length lst)))
       lst
      )
      ((> i (/ len 2))
       (reverse (ch-lst new (1- (- len i)) (reverse lst)))
      )
      (t
       (append
(progn
   (setq fst nil)
   (repeat (rem i 4)
     (setq fst (cons (car lst) fst)
   lst (cdr lst)
     )
   )
   (repeat (/ i 4)
     (setq fst (cons (cadddr lst)
     (cons (caddr lst)
   (cons
     (cadr lst)
     (cons
       (car lst)
       fst
     )
   )
     )
       )
   lst (cddddr lst)
     )
   )
   (reverse fst)
)
(list new)
(cdr lst)
       )
      )
    )
    (progn
      (setq j (cadr i)
    i (car i)
      )
      (if j
(progn
  (setq mid (nth i lst))
  (setq mid (ch-lst new j mid))
  (ch-lst mid i lst)
)
(ch-lst new i lst)
      )
    )
  )
)
;;;gile
(defun gile-CrossProduct (v1 v2)
  (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
(- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
(- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
  ) 
)


[chlh_jd]

However, now it need not the true UCS trans-matrix ,
Only  given  two points for the X-axis & origin ，and then get the translates matrix

[gile]

With only a point (origin) and a vector (Z axis), you can only build a 2d UCS matrix, IOW the Z axis should always be (0.0 0.0 1.0).

Code: [Select]

(setq p1 (getpoint "\nOrigin: "))
(setq p2 (getpoint p1 "\nX axis direction: "))
(setq l (distance p1 p2))
(setq xdir (mapcar '(lambda (x1 x2) (/ (- x2 x1) l)) (trans p1 1 0) (trans p2 1 0)))
(setq mat (list
    (list (car xdir) (cadr xdir) 0.0)
    (list (- (cadr xdir)) (car xdir) 0.0)
    '(0.0 0.0 1.0)
  )
)

[chlh_jd]

Thanks Gile a lot !

[did.ave]

Coucou

I just give my solution, too late perhaps, but I give it anyway.
eternal beginner I'm working to live up.

I give two points for the line
I give the center and radius, and if there is intersection,
I trace the center of the triangle at intersections.

amicalement

Code: [Select]

(defun ptk (k)
  (list (+ x1 (* k (- x2 x1))) (+ y1 (* k (- y2 y1))))
  )
 (defun aucarré (arg)
 (if (numberp arg)
 (* arg arg)
 )
)
;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+

(setq p1 (getpoint "\nPoint 1 ...\n")
      x1 (car p1)
      y1 (cadr p1)
      p2 (getpoint p1 "\nPoint 2 ...\n")
      x2 (car p2)
      y2 (cadr p2)
      )
      (grdraw p1 p2 1)
(setq centre (getpoint "\nCentre ...\n")
      x3 (car centre)
      y3 (cadr centre)
      rayon (getdist centre "\nRayon ...\n")
      )

(setq a (+ (aucarré (- x2 x1)) (aucarré (- y2 y1)))
      b (* (+ (* (- x2 x1)(- x1 x3))(* (- y2 y1)(- y1 y3))) 2.0)
      c (- (+ (aucarré x3)(aucarré y3)(aucarré x1)(aucarré y1))(* (+ (* x3 x1) (* y3 y1)) 2.0)(aucarré rayon))
      b2-4ac (- (aucarré b) (* a c 4.0))
      )

(cond ((> b2-4ac 0)
       (setq k (/ (- (* b -1)(sqrt b2-4ac))(* a 2.0))
             p1int (ptk k)
             k (/ (+ (* b -1)(sqrt b2-4ac))(* a 2.0))
             p2int (ptk k)
             )
       (command "_line" p1int centre p2int "c")
       )
  ;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
      ((< b2-4ac 0)(alert" pas d'intersection"))
      ;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
  ((= b2-4ac 0)
       (setq k (/ (* b -1)(* a 2.0))
             pint (ptk k)
             )
       (command "_line" pint centre "")
       )
      )
(princ)