常用公式大全！

將常用的數學公式，轉成LISP用的小函數，節省開發的時間喔！

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;由弧的兩點及凸出值求得交點
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ArcConner ( p1xy p2xy p1d / )
(setq ptc (CenPtByBulge p1xy p2xy p1d))
  (setq p1x (polar p1xy  (+ (angle ptc p1xy)(* 0.5 pi)) 1.0))
  (setq p2x (polar p2xy  (+ (angle ptc p2xy)(* 0.5 pi)) 1.0))
  (inters p1xy p1x p2xy p2x nil)
)



; {{{ 取得 不含 Z 的點 }}}
(defun XY( pt )
(list (car pt) (cadr pt) 0.0)
)

; {{{ 取得 不含 Z 的點 }}}
(defun XY0( pt )
(list (car pt) (cadr pt) 0.0)
)

; {{{ 判斷某值是否再兩值之間 }}}
(defun Between( v vmin vmax )
(and (>= v vmin) (<= v vmax))
)

; {{{ 判斷某點是否再兩點之間 }}}
(defun BetweenPt( pt pt1 pt2 )
(<= (+ (distance pt pt1) (distance pt pt2)) (distance pt1 pt2))
)

; {{{ 判斷某角度是否再兩角度之間 }}}
(defun BetweenAngle( an an_b an_e )
(if (> an_b an_e )
(or (between an 0.0 an_e) (between an an_b (* 2.0 pi)))
(between an an_b an_e)
)
)

; {{{ 取得 三點之夾角 }}}
(defun AngleBy3P( pta ptb ptc / a b c x an )
(setq a (distance ptb ptc))
(setq b (distance pta ptc))
(setq c (distance ptb pta))
(setq x (/ (- (+ (* b b) (* c c)) (* a a)) (* 2 b c)))
(setq an (atan (/ (sqrt (- 1 (* x x))) x)))
)


; {{{ 用三點取得圓心 }}}
(defun CenPtBy3P( pt1 pt2 pt3 / ma mb x1 y1 x2 y2 x3 y3 xc yc )
(setq x1 (car pt1 ))
(setq y1 (cadr pt1))
(if (= (car pt2) x1)
(setq x2 (car pt3) y2 (cadr pt3) x3 (car pt2) y3 (cadr pt2))
(setq x3 (car pt3) y3 (cadr pt3) x2 (car pt2) y2 (cadr pt2))
)
(setq ma (/ (- y2 y1 ) (- x2 x1 )))
(setq mb (/ (- y3 y2 ) (- x3 x2 )))
(if (/= ma mb ) (progn
(setq result 1)
(setq xc (/ (- (+ (* ma mb (- y1 y3)) (* mb (+ x1 x2))) (* ma (+ x2 x3)))
(* 2.0 (- mb ma)) ))
(if (= y1 y2)
(setq yc (/ (- (+ (expt (- x1 xc) 2) (expt y1 2))
  (+ (expt (- x3 xc) 2) (expt y3 2)) )
(* 2.0 (- y1 y3)) ))
(setq yc (/ (- (+ (expt (- x1 xc) 2) (expt y1 2))
  (+ (expt (- x2 xc) 2) (expt y2 2)) )
(* 2.0 (- y1 y2)) ))
)
(list xc yc)
))
)

; {{{ 用三點取得圓心-2 }}}
(defun getcpt (pt1 pt2 ptm / ang1m ang2m pt1m pt2m apt1m apt2m ptc)
(setq ang1m (angle pt1 ptm)
 ang2m (angle pt2 ptm)
)
  (setq pt1m (polar pt1 ang1m (* (distance pt1 ptm) 0.5))
 pt2m (polar pt2 ang2m (* (distance pt2 ptm) 0.5))
)
  (setq apt1m (polar pt1m (+ ang1m (* 0.5 pi)) 1.0)
 apt2m (polar pt2m (+ ang2m (* 0.5 pi)) 1.0)
)
  (setq ptc (inters pt1m apt1m pt2m apt2m nil))
)


; {{{ 用三點計算弧的凸出值 }}}
(defun BulgeBy3P( pt1 pt2 pt / ptm pt3 ptc d an r pttest bulge)
(if (setq ptc (CenPtBy3P pt1 pt2 pt)) (progn
(setq d (distance pt1 pt2))
(setq an (angle pt1 pt2))
(setq r  (distance ptc pt1))
(setq pt3 (polar ptc (+ an (* 0.5 PI)) 1.0))
(setq ptm (polar pt1 an (* 0.5 d)))
(setq pttest (polar ptm (- an (* 0.5 PI)) 1.0))
(if (inters pt1 pt2 ptc pt T)
(if (inters pt1 pt2 ptc pttest T)
(setq bulge (/ (- r (distance ptc ptm)) (* 0.5 d)))
(setq bulge (- 0.0 (/ (- r (distance ptc ptm)) (* 0.5 d))))
)
(if (inters pt1 pt2 ptc pttest T)
(setq bulge (- 0.0 (/ (+ r (distance ptc ptm)) (* 0.5 d))))
(setq bulge (/ (+ r (distance ptc ptm)) (* 0.5 d)))
)
)
))
bulge
)


; {{{ 判斷某點是否在某線段上 }}}
(defun OnBulge( pts ptb pte bulge / an d ptm ptc )
(setq lst '())
(if pts (progn
(if (= bulge 0)
(foreach pt pts
(if (= (+ (distance ptb pt) (distance pt pte)) (distance ptb pte))
(setq lst (append lst (list pt)))
)
)
(progn
(setq ptc (CenPtByBulge ptb pte bulge))
(foreach pt pts
(if (BetweenAngle (angle ptc pt) (angle ptc ptb) (angle ptc pte))
(setq lst (append lst (list pt)))
)
)
)
)
))
lst
)

; {{{ 用凸出值取得圓心 }}}
(defun CenPtByBulge( ptb pte bulge / an d ptm )
(setq an (angle ptb pte))
(setq d  (* 0.5 (distance ptb pte)))
(setq ptm (polar (polar ptb an d) (- an (* 0.5 pi)) (* bulge d)))
(CenPtBy3P ptb pte ptm)
)

; {{{ 取得兩線段的交叉點 }}}
(defun InterAA( ptb1 pte1 bulge1 ptb2 pte2 bulge2 onA / ptis ptc r ptc1 ptc2 )
(setq ptb1 (XY ptb1))
(setq pte1 (XY pte1))
(setq ptb2 (XY ptb2))
(setq pte2 (XY pte2))
(setq ptis '())
(cond
((= bulge1 bulge2 0.0)
(setq ptis (list (inters ptb1 pte1 ptb2 pte2 nil)))
)
((= bulge1 0.0)
(setq ptc (CenPtByBulge ptb2 pte2 bulge2))
(setq r  (distance ptc ptb2))
(setq ptis (interlc ptb1 pte1 ptc r))

)
((= bulge2 0.0)
(setq ptc (CenPtByBulge ptb1 pte1 bulge1))
(setq r  (distance ptc ptb1))
(setq ptis (interlc ptb2 pte2 ptc r))
)
(T
(setq ptc1 (CenPtByBulge ptb1 pte1 bulge1))
(setq ptc2 (CenPtByBulge ptb2 pte2 bulge2))
(setq ptis (intercc ptc1 (distance ptc1 ptb1) ptc2 (distance ptc2 ptb2)))
)
)
(cond ((= onA 3)(setq ptis (OnBulge (OnBulge ptis ptb2 pte2 bulge2) ptb1 pte1 bulge1)))
 ((= onA 2)(setq ptis (OnBulge ptis ptb2 pte2 bulge2)))
 ((= onA 1)(setq ptis (OnBulge ptis ptb1 pte1 bulge1)))
)
)

; {{{ 取得一圓圈與一線段的交叉點 }}}
(defun InterCA( ptc r ptb pte bulge onA / ptis ptc1 r1 )
(setq ptb (XY ptb))
(setq pte (XY pte))
(setq ptc (XY ptc))
(if (= bulge 0.0)
(setq ptis (interlc ptb pte ptc r))
(progn
(setq ptc1 (CenPtByBulge ptb pte bulge))
(setq r1 (distance ptc ptb))
(setq ptis (intercc ptc1 r1 ptc r))
)
)
(if (= onA 2)
(OnBulge ptis ptb pte bulge)
ptis
)
)


; {{{ 取得一直線與一圓圈的交叉點 }}}
(defun InterLC( pt1 pt2 ptc r / an ptm ptx d len ptis )
(setq pt1 (XY pt1))
(setq pt2 (XY pt2))
(setq ptc (XY ptc))
(setq an (angle pt1 pt2 ))
    (setq ptm (polar ptc (+ an (* 0.5 PI)) r))
(setq ptx (inters pt1 pt2 ptc ptm nil))
(setq d (distance ptc ptx))
(if (< d r ) (progn
(setq len (sqrt (- (* r r) (* d d))))
(setq ptis (list (polar ptx an len) (polar ptx (+ an pi) len)))
))
ptis
)

; {{{ 取得兩圓圈的交叉點 }}}
(defun InterCC( ptc1 r1 ptc2 r2 / d d2 d1 h a1 a ptis)
(setq ptc1 (XY ptc1))
(setq ptc2 (XY ptc2))
    (setq d  (distance ptc1 ptc2 ))
    (if (and (/= d 0.0) (< d (+ r1 r2)) (> (+ (min r1 r2) d) (max r1 r2)) ) (progn
        (setq d2 (/ (+ (- (* r2 r2) (* r1 r1)) (* d d) ) (+ d d)))
(setq d1 (- d d2))
(setq h (sqrt (abs (- (* r1 r1) (* d1 d1)))))
(setq a1 (atan2 h d1))
        (setq a  (angle ptc1 ptc2))
        (setq ptis (list (polar ptc1 (- a a1) r1) (polar ptc1 (+ a a1) r1)))
    ))
ptis
)



; {{{ 取得 lwpolyline 的外型描述(點及凸出值) }}}
(defun LPVertex( e 3d_pt / g et1 ptlst z_high )
(setq ptlst '())
(if e (progn
(setq g  (entget e))
(setq et1 g)
(if (= (cdr(assoc 0 g)) "LWPOLYLINE") (progn
(setq z_high (cdr(assoc 38 g)))
(while (/= (caar et1) 38) (setq et1 (cdr et1)) )
(setq et1 (cddr(reverse (cdr(reverse et1)))))
(while et1
(if 3d_pt
(setq ptlst (append ptlst (list (append (cdar et1) (list z_high)))))
(setq ptlst (append ptlst (list (cdar et1) )))
  )
(setq et1 (cddddr et1))
)
))
))
ptlst
)