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...

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