{"id":1299,"date":"2013-05-10T19:58:53","date_gmt":"2013-05-10T11:58:53","guid":{"rendered":"https:\/\/www.highflybird.com\/blog\/?p=147"},"modified":"2013-05-10T19:58:53","modified_gmt":"2013-05-10T11:58:53","slug":"%e6%a4%ad%e5%9c%86%e8%ae%ba","status":"publish","type":"post","link":"https:\/\/www.highflybird.com\/blog\/?p=1299","title":{"rendered":"\u692d\u5706\u8bba"},"content":{"rendered":"

\u5bf9\u692d\u5706\u7684\u7814\u7a76\u3002\u5176\u4e2d\u6709\u5927\u91cf\u7684\u4f7f\u7528\u51fd\u6570\uff1a
\n\u5305\u62ec\u692d\u5706\u7684\u5c55\u5f00\uff0c\u692d\u5706\u7684\u76f8\u4ea4\uff0c\u692d\u5706\u7684\u4f5c\u56fe\uff0c\u692d\u5706\u7684\u9762\u79ef\uff0c\u5468\u957f\u7b97\u6cd5\u4ee5\u53ca\u4e0e\u692d\u5706\u76f8\u5173\u7684\u65b9\u7a0b\u7b49\u8f83\u4e3a\u9ad8\u7ea7\u77e5\u8bc6\u3002
\n\u4e0b\u9762\u662f\u4ee3\u7801\uff1a<\/p>\n

<\/p>\n

\u4e00\u3001\u692d\u5706\u7684\u57fa\u672c\u8981\u7d20\u4e0e\u5176\u521b\u5efa\u548c\u66f4\u65b0
\n[codesyntax lang=”lisp”]
\n;|\u4e00 \u692d\u5706\u7684\u51e0\u4e2a\u57fa\u672c\u53c2\u6570\uff1a
\nDXF \u7ec4\u7801\u4e2d\u7684\u51e0\u4e2a\u6570\u503c
\n 10 \u692d\u5706\u4e2d\u5fc3
\n 11 \u957f\u8f74\u77e2\u91cf
\n 40 \u957f\u77ed\u6bd4\u7387
\n 41 \u8d77\u70b9\u89d2\u5ea6
\n 42 \u7ec8\u70b9\u89d2\u5ea6
\n210 \u6cd5\u7ebf\u77e2\u91cf
\n\u8fd9\u4e9b\u53c2\u6570\u53ef\u4ee5\u7531entget\u5f97\u5230\uff0c\u4e5f\u53ef\u4ee5\u7531activeX\u65b9\u6cd5\u5f97\u5230\u3002
\n\u6ce8: \u8d77\u70b9\u89d2\u5ea6\u548c\u7ec8\u70b9\u89d2\u5ea6\u7684\u8ba1\u7b97\uff0c\u5982\u679c\u662f\u4e0d\u662f\u692d\u5706\u5f27\uff0c\u662f\u5168\u692d\u5706\uff0c\u5219\u8fd9\u4e2a\u6570\u503c\u4e3a\uff1a
\n O \u548c2Pi\uff0c\u5982\u679c\u662f\u692d\u5706\u5f27\uff0c\u5219\u5982\u56fe1\uff1b
\n \u9700\u8981\u6ce8\u610f\u7684\u662fvla-get-StartAngle \u548c vla-get-StartParameter \u5728\u4e00\u822c\u60c5\u51b5
\n \u4e0b\uff0c\u662f\u4e24\u4e2a\u4e0d\u540c\u6570\u503c\uff0c\u5b83\u4eec\u6240\u4ee3\u8868\u7684\u89d2\u5ea6\u7684\u610f\u4e49\u5982\u4e0a\u56fe\u3002\u540c\u6837\u53bb\u7406\u89e3:
\n vla-get-EngAngle \u548c vla-get-EndParameter. \u4f46\u662f:
\n vla-get-StartParameter = vlax-curve-getStartParam
\n vla-get-EndParameter = vlax-curve-getEndParam
\n vlax-curve-getParamAtPoint \u5176\u53c2\u6570\u53ef\u6309\u7167\u4e0a\u8ff0\u65b9\u5f0f\u53bb\u7406\u89e3\u3002|;<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u753b\u4e00\u4e2a\u692d\u5706
\n;;; \u8f93\u5165: \u4e2d\u5fc3\uff0c\u957f\u8f74\uff0c\u77ed\u8f74\u548c\u65cb\u8f6c\u89d2\u5ea6
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u692d\u5706\u7684\u56fe\u5143\u540d\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun Ent:Make_Ellipse (cen a b ang \/ maj rat)
\n (if (> b a)
\n (setq maj (polar ‘(0 0 0) (+ ang (* pi 0.5)) b)
\n rat (\/ a (float b))
\n )
\n (setq maj (polar ‘(0 0 0) ang a)
\n rat (\/ b (float a))
\n )
\n )
\n (entmakeX
\n (list
\n ‘(0 . “ELLIPSE”)
\n ‘(100 . “AcDbEntity”)
\n ‘(100 . “AcDbEllipse”)
\n (cons 10 cen)
\n (cons 11 maj)
\n (cons 40 rat)
\n )
\n )
\n)<\/p>\n

(defun Ent:Make_Ellipse_1 (cen maj rat)
\n (entmakeX
\n (list
\n ‘(0 . “ELLIPSE”)
\n ‘(100 . “AcDbEntity”)
\n ‘(100 . “AcDbEllipse”)
\n (cons 10 cen)
\n (cons 11 maj)
\n (cons 40 rat)
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u753b\u4e00\u4e2a\u7a7a\u4e09\u7ef4\u7a7a\u95f4\u7684\u692d\u5706
\n;;; \u8f93\u5165: \u4e2d\u5fc3\uff0c\u957f\u8f74\uff0c\u77ed\u8f74\u3001\u65cb\u8f6c\u89d2\u5ea6\u548c\u6cd5\u7ebf\u77e2\u91cf
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u692d\u5706\u7684\u56fe\u5143\u540d\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun Ent:Make_Ellipse_3d (cen a b ang an1 an2 Normal \/ maj rat)
\n (if (> b a)
\n (setq maj (polar ‘(0 0 0) (+ ang (* pi 0.5)) b)
\n rat (\/ a b 1.0)
\n )
\n (setq maj (polar ‘(0 0 0) ang a)
\n rat (\/ b a 1.0)
\n )
\n )
\n (setq Normal (mat:unit Normal))
\n (setq maj (trans maj Normal 0 T))
\n (entmakeX
\n (list
\n ‘(0 . “ELLIPSE”)
\n ‘(100 . “AcDbEntity”)
\n ‘(100 . “AcDbEllipse”)
\n (cons 10 cen)
\n (cons 11 maj)
\n (cons 40 rat)
\n (cons 41 an1)
\n (cons 42 an2)
\n (cons 210 Normal)
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u753b\u4e00\u4e2a\u692d\u5706\u5f27
\n;;; \u8f93\u5165: \u4e2d\u5fc3\uff0c\u957f\u8f74\uff0c\u77ed\u8f74\u548c\u65cb\u8f6c\u89d2\u5ea6\uff0c\u8d77\u59cb\u89d2\u5ea6\uff0c\u7ec8\u70b9\u89d2\u5ea6
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u692d\u5706\u5f27\u7684\u56fe\u5143\u540d\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun Ent:Make_EllipseArc (cen a b ang an1 an2 \/ maj rat)
\n (if (> b a)
\n (setq maj (polar ‘(0 0 0) (+ ang (* pi 0.5)) b)
\n rat (\/ a b 1.0)
\n )
\n (setq maj (polar ‘(0 0 0) ang a)
\n rat (\/ b a 1.0)
\n )
\n )
\n (entmakeX
\n (list
\n ‘(0 . “ELLIPSE”)
\n ‘(100 . “AcDbEntity”)
\n ‘(100 . “AcDbEllipse”)
\n (cons 10 cen)
\n (cons 11 maj)
\n (cons 40 rat)
\n (cons 41 an1)
\n (cons 42 an2)
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u4ece\u67d0\u4e00\u70b9\u83b7\u53d6\u692d\u5706\u7684\u53c2\u6570(\u7eaf\u6570\u5b66\u6cd5)
\n;;; \u8f93\u5165: \u692d\u5706\u4e0a\u7684\u4e00\u70b9\u548c\u6784\u6210\u692d\u5706\u7684\u53c2\u6570\uff1a\u4e2d\u5fc3\uff0c\u534a\u957f\u8f74\uff0c\u534a\u77ed\u8f74\u548c\u65cb\u8f6c\u89d2
\n;;; \u8f93\u51fa: \u6b64\u70b9\u7684\u53c2\u6570\u503c
\n;;;=====================================================================
\n(defun ELL:GetParam (pt Cen a b ang \/ x y p)
\n (setq p (mapcar ‘- pt cen))
\n (setq x (car p))
\n (setq y (cadr p))
\n (atan
\n (* a (- (* y (cos ang))(* x (sin ang))))
\n (* b (+ (* x (cos ang))(* y (sin ang))))
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u66f4\u65b0\u5e73\u9762\u692d\u5706
\n;;; \u8f93\u5165: \u8981\u66f4\u65b0\u7684\u5b9e\u4f53\u540d\uff0c\u66f4\u65b0\u540e\u7684\u4e2d\u5fc3\uff0c\u534a\u957f\u8f74\uff0c\u534a\u77ed\u8f74\u548c\u65cb\u8f6c\u89d2
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u8be5\u5b9e\u4f53\u540d\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun ELL:Update (ent cen a b ang \/ D C X R m n an)
\n (if (> b a)
\n (setq m b n a an (+ ang (\/ pi 2)))
\n (setq m a n b an ang)
\n )
\n (setq D (entget ent))
\n (setq C (cons 10 cen))
\n (setq X (cons 11 (polar ‘(0. 0. 0.) an m)))
\n (setq R (cons 40 (\/ n m 1.0)))
\n (setq D (subst C (assoc 10 D) D))
\n (setq D (subst X (assoc 11 D) D))
\n (setq D (subst R (assoc 40 D) D))
\n (entmod D)
\n (entupd ent)
\n)
\n[\/codesyntax]
\n\u4e8c \u00a0\u692d\u5706\u7684\u66f2\u7387\u3001\u5f27\u957f\u3001\u9762\u79ef\u548c\u79bb\u5fc3\u7387
\n[codesyntax lang=”lisp”];;;=====================================================================
\n;;;\u529f\u80fd: \u83b7\u53d6\u692d\u5706\u4e0a\u4e00\u70b9\u5904\u7684\u66f2\u7387\u548c\u8f6c\u5f2f\u534a\u5f84
\n;;;\u53c2\u6570: \u692d\u5706\u5b9e\u4f53\u548c\u692d\u5706\u4e0a\u7684\u4e00\u70b9
\n;;;\u8fd4\u56de: \u6b64\u5904\u79bb\u5fc3\u5706\u5706\u5fc3\u3001\u8f6c\u5f2f\u534a\u5f84\u53ca\u5176\u66f2\u7387\uff08\u79bb\u5fc3\u7387\uff09
\n;;;\u8bf4\u660e: \u5982\u679c\u8981\u5728CAD\u4e2d\u51e0\u4f55\u4f5c\u56fe\uff0c\u53ef\u4ee5\u53c2\u8003\u6b64\u8d34\uff1a
\n;;; http:\/\/bbs.mjtd.com\/thread-62980-1-1.html
\n;;;=====================================================================
\n(defun ELL:GetCurvature (en pt \/ dxf maj rat a b p par x y k v1 v2 rad cen)
\n (setq dxf (entget en))
\n (setq maj (cdr (assoc 11 dxf)))
\n (setq rat (cdr (assoc 40 dxf)))
\n (setq a (distance ‘(0 0) maj))
\n (setq b (* a rat))
\n (setq p (vlax-curve-getclosestpointto en pt))
\n (setq par (vlax-curve-getParamAtPoint en p))
\n (setq v1 (vlax-curve-getFirstDeriv en par))
\n (setq v2 (list (- (cadr v1)) (car v1) (caddr v1)))
\n (setq x (* a (cos par)))
\n (setq y (* b (sin par)))
\n (setq k (expt rat 4))
\n (setq rad (\/ (expt (+ (* y y) (* k x x)) 1.5) rat rat b b))
\n (setq cen (polar p (angle ‘(0 0 0) v2) rad))
\n (list cen rad (\/ 1 rad))
\n)<\/p>\n

;;;\u6d4b\u8bd5\u692d\u5706\u7684\u66f2\u7387:
\n(defun c:GetCurvature (\/ sel ent dxf pnt ret)
\n (setq sel (nentselp “n\u9009\u53d6\u692d\u5706\uff1a”))
\n (if (and (setq ent (car sel))
\n (setq dxf (entget ent))
\n (= “ELLIPSE” (cdr (assoc 0 dxf)))
\n )
\n (progn
\n (setq pnt (cadr sel))
\n (setq ret (ELL:GetCurvature ent (trans pnt 1 0)))
\n (princ ret)
\n (entmakeX
\n (list
\n ‘(0 . “CIRCLE”)
\n (cons 10 (car ret))
\n (cons 40 (cadr ret))
\n )
\n )
\n )
\n )
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; \u692d\u5706\u7684\u79bb\u5fc3\u7387\u7531\u692d\u5706\u7684\u957f\u77ed\u6bd4\u7387\u5f97\u51fa\u3002(sqrt (- 1 (* ratio ratio)))
\n;;; \u79bb\u5fc3\u7387\u8d8a\u5927\u5706\u5c31\u8d8a\u6241\uff0c\u8d8a\u5c0f\u5219\u8d8a\u63a5\u8fd1\u4e8e\u5706
\n;;;———————————————————————
\n;;; \u529f\u80fd: \u83b7\u53d6\u692d\u5706\u7684\u79bb\u5fc3\u7387\uff0c\u503c\u8d8a\u5927\u5f62\u72b6\u8d8a\u6241\uff0c\u8d8a\u5c0f\u8d8a\u63a5\u8fd1\u5706
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u56fe\u5143\u540d
\n;;; \u8f93\u51fa: \u692d\u5706\u7684\u79bb\u5fc3\u7387
\n;;;=====================================================================
\n(defun ELL:Eccentricity (e \/ ratio)
\n (setq ratio (cdr (assoc 40 (entget e))))
\n (sqrt (- 1 (* ratio ratio)))
\n)<\/p>\n

;;;=====================================================================
\n;;; \u53cd\u4f59\u5207\u51fd\u6570
\n;;;=====================================================================
\n(defun Math:acot (x y)
\n (atan y x)
\n)<\/p>\n

;;;=====================================================================
\n;;; \u516d\u4e2a\u53c2\u6570\u7684\u692d\u5706\u65b9\u7a0b
\n;;;=====================================================================
\n(defun ELL:QuadraticEquation (a b c d f g \/ O S I J K M R X Y)
\n (setq b (* 0.5 b))
\n (setq d (* 0.5 d))
\n (setq f (* 0.5 f))
\n (setq S (mat:det3 a b d b c f d f g))
\n (setq J (- (* a c) (* b b)))
\n (setq I (float (+ a c)))
\n (if (and (not (equal S 0 1e-14)) (> j 0) (MINUSP (\/ S I)))
\n (progn
\n (setq O (list (\/ (- (* b f) (* c d)) j) (\/ (- (* b d) (* a f)) j)))
\n (setq k (- (+ (* a f f) (* c d d) (* g b b)) (* 2 b d f) (* a c g)))
\n (setq k (+ k k))
\n (setq m (sqrt (+ (* 4 b b) (* (- a c) (- a c)))))
\n (setq x (sqrt (\/ k (* J (- I m)))))
\n (setq y (sqrt (\/ k (* J (+ I m)))))
\n (setq r (* 0.5 (atan (+ b b) (- a c))))
\n (list O x y (+ r (* pi 0.5)))
\n )
\n )
\n)<\/p>\n

(defun ELL:5PE (p1 p2 p3 p4 p5 \/ ret)
\n (setq
\n ret
\n (Mat:Gauss_Equations
\n (mapcar
\n (function
\n (lambda (p \/ x y)
\n (setq x (car p))
\n (setq y (cadr p))
\n (list (* x y) (* y y) x y 1 (- (* x x)))
\n )
\n )
\n (list p1 p2 p3 p4 p5)
\n )
\n )
\n )
\n (if ret
\n (apply ‘ELL:QuadraticEquation (cons 1 ret))
\n )
\n)<\/p>\n

(defun c:xxx ()
\n (setq i 1)
\n (setq lst nil)
\n (while (< i 6)
\n (initget 1)
\n (setq p (getpoint (strcat “n\u7b2c” (itoa i) “\u70b9:”)))
\n (setq i (1+ i))
\n (ent:make_point p)
\n (setq lst (cons p lst))
\n )
\n (setq kkk (apply ‘ELL:5PE lst))
\n (defun f1 (lst)
\n (apply ‘ell:5pe lst)
\n )
\n (defun f2 (lst)
\n (apply ‘ELL:5PEllipse lst)
\n )
\n (misc:test 10000
\n ‘((f1 lst)
\n (f2 lst)
\n )
\n )
\n (if kkk
\n (apply ‘Ent:make_ellipse kkk)
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u8bf4\u660e: \u6b64\u51fd\u6570\u4e3a\u7eaf\u6570\u5b66\u8ba1\u7b97\uff0c\u610f\u5473\u53ef\u4e0d\u7528\u56fe\u5143\u53c2\u4e0e\uff0c\u91c7\u7528\u4e86\u9f99\u8d1d\u5854\u79ef\u5206\u6cd5\u3002
\n;;; \u9002\u7528\u4e8e\u67d0\u4e9b\u7279\u6b8a\u60c5\u51b5\u3002\u4e00\u822c\u53ef\u7528vlax-curve\u51fd\u6570\u83b7\u5f97\u3002\u89c1\u6837\u4f8b\u3002
\n;;; \u529f\u80fd: \u83b7\u53d6\u692d\u5706\u5f27\u7684\u957f\u5ea6\u3002
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u957f\u534a\u8f74\uff0c\u77ed\u534a\u8f74\uff0c\u53c2\u65701\uff0c\u53c2\u65702\u548c\u7cbe\u5ea6
\n;;; \u8f93\u51fa: \u692d\u5706\u5f27\u7684\u957f\u5ea6
\n;;;=====================================================================
\n(defun ELL:Length (la lb p1 p2 eps \/ Func ratio 0.5Pi)
\n (defun Func (x \/ cx ee)
\n (setq cx (cos x))
\n (setq ee (* (1+ ratio) (1- ratio)))
\n (sqrt (1+ (* ee cx cx)))
\n )<\/p>\n

(if (<= lb la)
\n (progn
\n (setq ratio (\/ lb (float la)))
\n (* la (Math:Romberg p1 p2 eps))
\n )
\n (progn
\n (setq ratio (\/ la (float lb)))
\n (setq 0.5Pi (* pi 0.5))
\n (* lb (Math:Romberg (- p1 0.5pi) (- p2 0.5pi) eps))
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u8bf4\u660e: \u6b64\u51fd\u6570\u4e3a\u7eaf\u6570\u5b66\u8ba1\u7b97\uff0c\u610f\u5473\u53ef\u4e0d\u7528\u56fe\u5143\u53c2\u4e0e\uff0c\u901f\u5ea6\u5c45\u7136\u4e0d\u6162\u3002
\n;;; \u9002\u7528\u4e8e\u67d0\u4e9b\u7279\u6b8a\u60c5\u51b5\u3002\u4e00\u822c\u53ef\u7528vlax-curve-getarea\u51fd\u6570\u83b7\u5f97\uff0c\u4e5f\u53ef\u4ee5
\n;;; \u7528vla-get-area\u83b7\u5f97\u3002\u6d4b\u8bd5\u89c1\u6837\u4f8b\u3002
\n;;; \u529f\u80fd: \u83b7\u53d6\u692d\u5706\u5f27\u7684\u9762\u79ef\u3002
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u957f\u534a\u8f74\uff0c\u77ed\u534a\u8f74\uff0c\u53c2\u65701\uff0c\u53c2\u65702
\n;;; \u8f93\u51fa: \u692d\u5706\u5f27\u7684\u9762\u79ef
\n;;;=====================================================================
\n(defun ELL:Area (la lb A1 A2 \/ a k)
\n (if (> A1 A2)
\n (setq A (- (+ pi pi A2) A1))
\n (setq A (- A2 A1))
\n )
\n (setq k (sin (* 0.5 A)))
\n (setq k (* 1.333333333333333333333 la k k k))
\n (* 0.5 la lb (- A (sin A)))
\n)<\/p>\n

;;;\u6d4b\u8bd5\u692d\u5706\u5f27\u957f\u548c\u9762\u79ef\u6837\u4f8b
\n(defun c:TestLA (\/ e o la lb par1 par2 l1 l2 s1 s2 s3)
\n (setq e (car (entsel “n\u8bf7\u9009\u62e9\u692d\u5706\u5f27: “)))
\n (setq o (vlax-ename->vla-object e))
\n (setq la (vla-get-MajorRadius o))
\n (setq lb (vla-get-MinorRadius o))
\n (setq par1 (vlax-curve-getStartParam e))
\n (setq par2 (vlax-curve-getEndParam e))
\n (setq l1 (ell:length la lb par1 par2 1e-14)) ; \u7528\u6570\u5b66\u8ba1\u7b97\u83b7\u5f97\u692d\u5706\u5f27\u957f
\n (setq l2 (vlax-curve-getDistAtParam e par2)) ; \u7528vlax-curve\u7684\u51fd\u6570\u83b7\u5f97\u692d\u5706\u5f27\u957f
\n (princ “n\u7528vlax-curve\u51fd\u6570\u8ba1\u7b97\u7684\u7ed3\u679c\u548c\u79ef\u5206\u6cd5\u8ba1\u7b97\u76f8\u5dee:”)
\n (princ (rtos (- l1 l2) 2 20))
\n (misc:test 1001
\n ‘((ell:length la lb par1 par2 1e-8) ; \u56e0\u4e3a\u692d\u5706\u5f27\u957f\u6ca1\u6709\u6570\u5b66\u516c\u5f0f\uff0c\u6240\u4ee5\u6162\u4e86
\n (vlax-curve-getDistAtParam e par2)
\n )
\n )
\n (setq s1 (vla-get-area o))
\n (setq s2 (ELL:Area la lb par1 par2))
\n (setq s3 (vlax-curve-getarea e))
\n (princ “n\u7528vla-get-area\u51fd\u6570\u8ba1\u7b97\u7684\u7ed3\u679c\u548c\u6570\u5b66\u6cd5\u8ba1\u7b97\u76f8\u5dee:”)
\n (princ (list s1 s2 s3))
\n (princ (rtos (- s1 s2) 2 20))
\n (misc:test 1001
\n ‘((ELL:Area la lb par1 par2) ; \u5c45\u7136\u7528\u8fd9\u4e2a\u65b9\u6cd5\u6700\u5feb??
\n (vla-get-area o)
\n (vlax-curve-getarea e)
\n )
\n )
\n (princ)
\n)
\n[\/codesyntax]
\n\u4e09\u3001\u7a7a\u95f4\u692d\u5706\u7684\u53d8\u6362\u77e9\u9635\u53ca\u5176\u6cd5\u7ebf\u548c\u5e73\u9762\u6295\u5f71
\n[codesyntax lang=”lisp”];;;=====================================================================
\n;;; \u529f\u80fd: \u83b7\u53d6\u692d\u5706\u7684\u53d8\u6362\u77e9\u9635
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u56fe\u5143\u540d
\n;;; \u8f93\u51fa: \u692d\u5706\u7684\u53d8\u6362\u77e9\u9635\u53ca\u9006\u77e9\u9635
\n;;; \u8bf4\u660e: \u7531\u692d\u5706\u7684\u957f\u8f74\u77e2\u91cf\uff0c\u548c\u77ed\u8f74\u77e2\u91cf\u4ee5\u53ca\u6cd5\u7ebf\u77e2\u91cf\u53ef\u4ee5\u6784\u6210\u692d\u5706\u81ea\u8eab\u7684\u53d8\u6362
\n;;; \u77e9\u9635\u3002\u5982\u679c\u692d\u5706\u4f4d\u4e8e\u56fe\u5757\u5185\u6216\u8005\u5d4c\u5957\u5757\u5185\uff0c\u5173\u4e8e\u5176\u53d8\u6362\u77e9\u9635\u53ef\u4ee5\u53c2\u8003\u8fd9
\n;;; \u4e2a\u5e16\u5b50\u7684\u8ba8\u8bba\uff1ahttp:\/\/bbs.mjtd.com\/thread-93828-1-1.html.
\n;;; \u6b64\u5e16\u4e2d\u5bf9\u692d\u5706\u7684\u53d8\u6362\u8ba8\u8bba\u7684\u6bd4\u8f83\u6df1\u5165\u3002
\n;;;=====================================================================
\n(defun ELL:TransMatrix (e \/ Obj Cen DX DY DZ mat)
\n (setq obj (vlax-ename->vla-object e))
\n (setq Cen (vlax-get obj ‘Center)) ; \u4e2d\u5fc3\u70b9
\n (setq DX (Mat:unit (vlax-get obj ‘MajorAxis))) ; OCS\u7684X\u8f74\u65b9\u5411 \u957f\u8f74\u65b9\u5411
\n (setq DY (Mat:unit (vlax-get obj ‘MinorAxis))) ; OCS\u7684Y\u8f74\u65b9\u5411 \u77ed\u8f74\u65b9\u5411
\n (setq DZ (Mat:unit (vlax-get obj ‘Normal))) ; OCS\u7684Z\u8f74\u65b9\u5411 \u6cd5\u7ebf\u65b9\u5411
\n (setq mat (list DX DY DZ)) ; \u692d\u5706\u7684\u65cb\u8f6c\u77e9\u9635
\n (list
\n (Mat:DispToMatrix (Mat:trp mat) cen) ; \u692d\u5706\u7684\u53d8\u6362\u77e9\u9635 = (trans Pt En 0)
\n (Mat:DispToMatrix mat (mapcar ‘- (Mat:mxv mat cen))) ; \u692d\u5706\u7684\u9006\u53d8\u6362\u77e9\u9635 = (trans Pt 0 En)
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u83b7\u53d6\u692d\u5706\u7684\u65cb\u8f6c\u77e9\u9635
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u957f\u8f74\u77e2\u91cf\u548c\u692d\u5706\u7684\u6cd5\u7ebf
\n;;; \u8f93\u51fa: \u692d\u5706\u7684\u65cb\u8f6c\u53d8\u6362\u77e9\u9635\u53ca\u9006\u77e9\u9635
\n;;;=====================================================================
\n(defun ELL:RotationMatrix (Maj Nrm \/ DX DY DZ mat)
\n (setq DX (Mat:unit Maj)) ; OCS\u7684X\u8f74\u65b9\u5411
\n (setq DZ (Mat:unit Nrm)) ; OCS\u7684Z\u8f74\u65b9\u5411
\n (setq DY (Mat:Unit (Mat:vxv DZ DX))) ; OCS\u7684Y\u8f74\u65b9\u5411
\n (setq mat (list DX DY DZ)) ; \u692d\u5706\u7684\u65cb\u8f6c\u77e9\u9635\u7684\u9006\u77e9\u9635
\n (list (Mat:trp mat) mat) ; \u692d\u5706\u7684\u65cb\u8f6c\u77e9\u9635\u548c\u9006\u77e9\u9635
\n)<\/p>\n

;;;\u4ee5\u4e0b\u4e3a\u6d4b\u8bd5\u7a0b\u5e8f
\n(defun c:testMatrix (\/ sel ent mat obj doc)
\n (if (setq sel (ssget “:S” ‘((0 . “ELLIPSE”))))
\n (progn
\n (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
\n (vla-StartUndoMark doc)
\n (setq ent (ssname sel 0))
\n (setq mat (ELL:TransMatrix ent))
\n (setq obj (vlax-ename->vla-object ent))
\n (vla-transformby obj (vlax-tmatrix (cadr mat)))
\n (command “Select” ent pause)
\n (vla-transformby obj (vlax-tmatrix (car mat)))
\n (vla-EndUndoMark doc)
\n (princ)
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u4fee\u6539\u4e00\u4e2a\u692d\u5706\u7684\u6cd5\u7ebf\u65b9\u5411(\u4e0d\u80fd\u76f4\u63a5\u7528ActiveX\u65b9\u6cd5)
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u56fe\u5143\u540d\uff0c\u76ee\u6807\u6cd5\u7ebf\u65b9\u5411
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u692d\u5706\u7684DXF\u8868\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun ELL:Put_Normal (ent Nrm \/ DXF Maj)
\n (setq Nrm (mat:unit Nrm))
\n (setq dxf (entget ent))
\n (setq maj (cdr (assoc 11 dxf))) ; \u9996\u5148\u53d6\u5f97\u4e3b\u8f74\u65b9\u5411
\n (setq maj (trans maj 0 (cdr (assoc 210 dxf)) T)) ; \u4e3b\u8f74\u65b9\u5411\u5728OCS\u4e2d\u7684\u65b9\u5411
\n (setq maj (trans Maj Nrm 0 T)) ; \u628aOCS\u4e2d\u7684\u65b9\u5411\u8f6c\u5316\u4e3a\u76ee\u6807\u65b9\u5411
\n (setq dxf (subst (cons 11 maj) (assoc 11 dxf) dxf)) ; \u692d\u5706\u7684\u4e3b\u8f74\u65b9\u5411
\n (setq dxf (subst (cons 210 Nrm) (assoc 210 dxf) dxf)) ; \u692d\u5706\u7684\u6cd5\u7ebf\u65b9\u5411
\n (entmod dxf) ; \u66f4\u65b0\u56fe\u5143
\n)<\/p>\n

;;;=====================================================================
\n;;; highflybird 2012.11.1 \u7b2c\u4e00\u7248 2013.5.25 \u4fee\u6539\u4e8e\u6df1\u5733
\n;;; \u529f\u80fd: \u7ed9\u5b9a\u4e00\u4e2a\u692d\u5706\u6216\u8005\u5706\uff0c\u753b\u51fa\u5728\u5e73\u9762\u4e0a\u7684\u6295\u5f71\uff08\u4e00\u822c\u4e3a\u692d\u5706\uff09
\n;;; \u8f93\u5165: (\u692d\u5706\u3001\u692d\u5706\u5f27\u3001\u5706\u5f27\u3001\u5706)\u5b9e\u4f53E\uff0c\u5e73\u9762\u7684\u6cd5\u7ebfNormal\u548c\u5176\u4e00\u70b9Origin
\n;;; \u8f93\u51fa: \u6295\u5f71\u692d\u5706(\u521b\u5efa3d\u692d\u5706\u7684\u51e0\u4e2a\u53c2\u6570)
\n;;; \u53c2\u8003: http:\/\/bbs.mjtd.com\/forum.php?mod=viewthread&tid=84527
\n;;; http:\/\/www.theswamp.org\/index.php?topic=43031.0
\n;;;=====================================================================
\n(defun ELL:Projection (E Normal Origin \/
\n A1 AN1 AN2 ANG B1 C0 C1 C2 ENT OBJ PA0
\n PA1 PB0 PB1 PE0 PE1 PR1 PR2 PS0 PS1 RET)
\n (setq C0 (cdr (assoc 10 (entget E)))) ; \u4e2d\u5fc3\u70b9(\u7528vla-get-center\u53ef\u80fd\u51fa\u9519\uff1f)
\n (setq C0 (trans C0 e 0)) ; \u6b64\u5904\u5f88\u91cd\u8981!!!
\n (setq PS0 (vlax-curve-getStartPoint E)) ; \u8fd9\u4e2a\u53ef\u4ee5\u901a\u8fc7\u89d2\u5ea6\u8ba1\u7b97\u51fa\u6765StartAngle
\n (setq PE0 (vlax-curve-getEndPoint E)) ; \u8fd9\u4e2a\u53ef\u4ee5\u901a\u8fc7\u89d2\u5ea6\u8ba1\u7b97\u51fa\u6765EndAngle
\n (setq Pr1 (vlax-curve-getStartParam E))
\n (setq Pr2 (vlax-curve-getEndParam E))
\n (if (LINE:Colinearity C0 PS0 PE0) ; \u9632\u6b62\u4e2d\u5fc3\uff0c\u8d77\u70b9\uff0c\u7ec8\u70b9\u5171\u7ebf\u60c5\u51b5\u51fa\u73b0
\n (setq PA0 (vlax-curve-getPointAtParam E (1+ pr1)) ; \u8d77\u70b9\u53c2\u6570\u52a0\u4e00
\n pB0 (vlax-curve-getpointatparam E (1- pr2)) ; \u7ec8\u70b9\u53c2\u6570\u52a0\u4e00
\n )
\n (setq pA0 (vlax-curve-getpointatparam E (* 0.5 (+ pr1 pr2))) ; \u53d6\u4e2d\u70b9\u4e3a\u7b2c\u4e8c\u70b9
\n pB0 PE0 ; \u7ec8\u70b9\u4e3a\u7b2c\u4e09\u70b9
\n )
\n )<\/p>\n

(mapcar
\n (function (lambda (x y) (set x (trans y 0 Normal)))) ; \u628a\u8fd9\u4e9b\u70b9\u6295\u5f71\u5230\u5e73\u9762\u4e0a
\n (quote (PA1 PB1 PS1 PE1 C1))
\n (list PA0 PB0 PS0 PE0 C0) ; \u692d\u5706\u4e0a\u53d6\u7684\u4e09\u70b9\u3001\u8d77\u59cb\u70b9\u548c\u7aef\u70b9
\n )
\n (if (setq RET (ELL:C3P C1 PS1 PA1 PB1)) ; \u4e2d\u5fc3\u548c\u4e09\u70b9\u753b\u692d\u5706\u6cd5
\n (progn
\n (setq A1 (cadr ret)) ; \u6295\u5f71\u692d\u5706\u7684\u957f\u8f74
\n (setq B1 (caddr ret)) ; \u6295\u5f71\u692d\u5706\u7684\u77ed\u8f74
\n (setq ang (cadddr ret)) ; \u6295\u5f71\u692d\u5706\u7684\u65cb\u8f6c\u89d2
\n (setq C2 (PLANE:Perpendicular_Foot c0 Origin Normal)) ; \u692d\u5706\u7684\u5b9e\u9645\u4e2d\u5fc3
\n (if (vlax-curve-isClosed E)
\n (list C2 A1 B1 ang 0 (+ pi pi) Normal) ; \u8fd4\u56de\u521b\u5efa3d\u692d\u5706\u7684\u51e0\u4e2a\u53c2\u6570
\n (progn
\n (setq an1 (ELL:GetParam PS1 C1 A1 B1 ang)) ; \u6295\u5f71\u692d\u5706\u7684\u8d77\u59cb\u53c2\u6570
\n (setq an2 (ELL:GetParam PE1 C1 A1 B1 ang)) ; \u6295\u5f71\u692d\u5706\u7684\u7ec8\u70b9\u53c2\u6570
\n (if (> (TRI:Det3P pS1 pA1 pB1) 0) ; \u6b64\u5904\u7684\u786e\u8981\u4f5c\u5224\u65ad
\n (list C2 a1 b1 ang an1 an2 Normal) ; \u6b64\u65f6\u662f\u9006\u65f6\u9488
\n (list C2 a1 b1 ang an2 an1 Normal) ; \u987a\u65f6\u9488\u8981\u4ea4\u6362\u8d77\u59cb\u89d2\u548c\u7ec8\u6b62\u89d2
\n )
\n )
\n )
\n )
\n )
\n)<\/p>\n

;;;\u7528\u4e8e\u6295\u5f71\u692d\u5706\u7684\u6d4b\u8bd5:
\n(defun C:Projection (\/ sel ent normal origin i ret)
\n (setq sel (ssget ‘((0 . “ELLIPSE,ARC,CIRCLE”))))
\n (setq normal (trans ‘(0 0 1) 1 0 T))
\n (setq origin (getvar ‘ucsorg))
\n (if sel
\n (repeat (setq i (sslength sel))
\n (setq ent (ssname sel (setq i (1- i))))
\n (if (setq ret (ELL:Projection ent normal origin))
\n (apply ‘Ent:Make_ELLIPSE_3D ret)
\n )
\n )
\n )
\n)[\/codesyntax]
\n\u56db\u3001\u692d\u5706\u7684\u5c55\u70b9\u548c\u692d\u5706\u9525\u7684\u5c55\u5f00\u66f2\u7ebf
\n[codesyntax lang=”lisp”];;;=====================================================================
\n;;; \u529f\u80fd: \u692d\u5706\u5c55\u70b9\u3002
\n;;; \u8f93\u5165: \u65e0
\n;;; \u8f93\u51fa: \u65e0
\n;;;=====================================================================
\n(defun C:ExpandEllipse(\/ A B D ENT F I L LEN N OBJ P PAR S SEG)
\n (initget 15)
\n (setq a (getdist “n\u8bf7\u8f93\u5165\u692d\u5706\u7684\u957f\u8f74:”))
\n (initget 15)
\n (setq b (getdist “n\u8bf7\u8f93\u5165\u692d\u5706\u7684\u77ed\u8f74:”))
\n (initget 7)
\n (setq n (getint “n\u8bf7\u8f93\u5165\u7b49\u5206\u6570\u76ee:”))
\n (setq ent (ENT:MAKE_ELLIPSE ‘(0 0 0) a b 0))
\n (setq obj (vlax-ename->vla-object ent))
\n (setq par (vlax-curve-getendparam obj))
\n (setq len (vlax-curve-getdistatparam obj par))
\n (setq seg (\/ len n))
\n (setq l nil)
\n (setq d 0)
\n (setq i 0)
\n (repeat n
\n (setq d (* i seg))
\n (setq p (vlax-curve-getPointAtDist obj d))
\n ;(Ent:Make_Point p)
\n (setq l (cons p L))
\n (setq i (1+ i))
\n )
\n (setq l (reverse l))<\/p>\n

(vla-erase obj)
\n (if (setq f (getfiled “\u8f93\u5165\u5750\u6807\u6587\u4ef6\u540d” “D:\/” “TXT” 1))
\n (progn
\n (setq f (open f “W”))
\n (foreach p l
\n (setq s (strcat (rtos (car p) 2 8) “t” (rtos (cadr p) 2 8)))
\n (write-line s f)
\n )
\n (close f)
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u5c55\u5f00\u692d\u5706\u9525\u4f53\u3002
\n;;; \u8f93\u5165: \u692d\u5706\u9525\u5e95\u692d\u5706\u7684\u957f\u8f74a\uff0c\u77ed\u8f74b\uff0c\u692d\u5706\u9525\u7684\u9ad8h\u548c\u5206\u5f27\u7cbe\u5ea6n
\n;;; \u8f93\u51fa: \u5c55\u5f00\u56fe\u7684\u66f2\u7ebf\u7684\u5750\u6807\u70b9(\u53ef\u636e\u6b64\u5f62\u6210\u5c55\u5f00\u9762)
\n;;;=====================================================================
\n(defun ELL:ExpandCone (a b h n \/ Pts Ang D Param DivAng P0 P1 R0 R1 X Y)
\n (setq DivAng (\/ pi n 0.5)) ;\u7b49\u5206\u89d2\u5ea6
\n (setq Param 0) ;\u5f00\u59cb\u53c2\u6570\u4e3a0
\n (setq p0 (list a 0)) ;\u4ece\u692d\u5706\u6700\u53f3\u8fb9\u7684\u70b9\u5f00\u59cb
\n (setq r0 (distance ‘(0 0 0) (list a 0 h))) ;\u5f00\u59cb\u7684\u9525\u9876\u6700\u53f3\u8fb9\u70b9\u7684\u8ddd\u79bb
\n (setq Pts (list (list r0 0) ‘(0 0))) ;\u628a\u6700\u5f00\u59cb\u7684\u4e24\u70b9\u52a0\u5165\u5230\u6570\u636e\u8868
\n (setq Ang 0) ;\u5f00\u59cb\u89d2\u5ea6\u4e5f\u4e3a0
\n (repeat n
\n (setq Param (+ Param DivAng))
\n (setq x (* a (cos Param))) ;\u692d\u5706\u4e0a\u7684x\u5750\u6807
\n (setq y (* b (sin Param))) ;\u692d\u5706\u4e0a\u7684y\u5750\u6807
\n (setq p1 (list x y)) ;\u70b9\u7684\u5750\u6807
\n (setq r1 (distance ‘(0 0 0) (list x y h))) ;\u5c55\u5f00\u9762\u7684\u9525\u7ebf\u957f\u5ea6
\n (setq d (distance p0 p1)) ;\u692d\u5706\u4e0a\u7684\u4e0a\u4e00\u70b9\u5230\u8fd9\u70b9\u7684\u8ddd\u79bb
\n (setq Ang (+ Ang (car (TRI:CosinesLaw d r0 r1)))) ;\u5750\u6807\u89d2\u5ea6
\n (setq Pts (cons (polar ‘(0 0) Ang r1) Pts)) ;\u5f97\u5230\u4e86\u5750\u6807\uff0c\u5e76\u628a\u5b83\u52a0\u5165\u5230\u8868\u4e2d
\n (setq p0 p1) ;\u7528\u65b0\u7684\u5750\u6807\u4f4d\u7f6e\u66ff\u6362\u65e7\u4f4d\u7f6e
\n (setq r0 r1) ;\u7528\u65b0\u7684\u9525\u7ebf\u957f\u5ea6\u66ff\u6362\u65e7\u957f\u5ea6
\n )
\n (reverse Pts) ;\u9006\u8f6c\u8868\uff0c\u5f97\u5230\u6b63\u5e8f\u7684\u6570\u636e
\n)<\/p>\n

;;; \u6d4b\u8bd5\u692d\u5706\u9525\u7684\u5c55\u5f00
\n(defun c:ExpandCone(\/ h N e d r c m a b l e o)
\n (initget 1)
\n (setq h (getdist “n\u8f93\u5165\u692d\u5706\u9525\u9ad8: “))
\n (initget 7)
\n (setq N (getint “n\u7b49\u5206\u6570:”))
\n (prompt “n\u9009\u62e9\u692d\u5706:”)
\n (if (setq s (ssget “:S” ‘((0 . “ELLIPSE”))))
\n (progn
\n (setq e (ssname s 0))
\n (setq d (entget e))
\n (setq r (cdr (assoc 40 d)))
\n (setq c (cdr (assoc 10 d)))
\n (setq m (cdr (assoc 11 d)))
\n (setq a (distance ‘(0 0 0) m))
\n (setq b (* r a))
\n (setq l (ELL:ExpandCone a b h n))
\n (setq o (vlax-ename->vla-object (Ent:Make_LWPoly l T)))
\n (vla-move o (vlax-3d-point ‘(0 0 0)) (vlax-3d-point c))
\n (princ)
\n )
\n )
\n)[\/codesyntax]
\n\u4e94\u3001\u692d\u5706\u7684\u76f8\u5207\u548c\u76f8\u4ea4
\n[codesyntax lang=”lisp”];;;=====================================================================
\n;;; \u529f\u80fd: \u6570\u5b66\u6cd5\u6c42\u692d\u5706\u4e0a\u4e00\u70b9\u7684\u5207\u7ebf\u77e2\u91cf(\u76f8\u5f53\u4e8evlax-curve-GetFirstDeriv)
\n;;; \u8f93\u5165: \u8fd9\u70b9\u7684\u53c2\u6570Param,\u692d\u5706\u4e2d\u5fc3C,\u957f\u8f74\u65b9\u5411M\uff0c\u692d\u5706\u6bd4\u7387R\u548c\u692d\u5706\u7684\u6cd5\u7ebfN
\n;;; \u8f93\u51fa: \u8fd9\u70b9\u7684\u5207\u7ebf\u77e2\u91cf
\n;;;=====================================================================
\n(defun ELL:PointTangentOn (Param C M R N \/ a b v)
\n (setq a (distance ‘(0 0 0) M))
\n (setq b (* R a))
\n (setq v (list (* (- a) (sin Param)) (* b (cos Param)) 0))
\n (Mat:mxv (car (ELL:RotationMatrix M N)) v)
\n)<\/p>\n

;;; \u5207\u7ebf\u77e2\u91cf\u51fd\u6570\u6d4b\u8bd5
\n(defun C:PointTangentOn ( \/ CEN DXF ENT MAJ NRM PAR PNT RAT RET SEL)
\n (if (setq sel (ssget “:S” ‘((0 . “ELLIPSE”))))
\n (progn
\n (setq ent (ssname sel 0))
\n (setq dxf (entget ent))
\n (setq cen (cdr (assoc 10 dxf)))
\n (setq maj (cdr (assoc 11 dxf)))
\n (setq rat (cdr (assoc 40 dxf)))
\n (setq Nrm (cdr (assoc 210 DXF)))
\n (while (setq Pnt (getpoint “n\u9009\u53d6\u70b9: “))
\n (setq Pnt (trans Pnt 1 0))
\n (setq pnt (vlax-curve-getclosestpointto ent pnt))
\n (setq par (vlax-curve-getParamAtPoint ent pnt))
\n (setq ret (ELL:PointTangentOn par cen maj rat Nrm))
\n (ent:make_line Pnt (mapcar ‘+ Pnt ret))
\n )
\n (princ)
\n )
\n )
\n)<\/p>\n

;;; \u4e0a\u9762\u662f\u4e5f\u53ef\u4ee5\u7531\u67d0\u4e2a\u70b9\u7684\u53c2\u6570\u901a\u8fc7\u6570\u5b66\u65b9\u6cd5\u7b97\u51fa\u3002
\n;;; \u4e00\u822c\u6765\u8bf4\u53ef\u4ee5\u7531vlax-curve-getFirstDeriv \u7b97\u51fa\uff0c\u9762\u662f\u6d4b\u8bd5\u5982\u4e0b:
\n(defun C:TestDeriv (\/ e o p param f1 f2)
\n (if (setq e (car (entsel)))
\n (progn
\n (setq o (vlax-ename->vla-object e))
\n (while (setq p (getpoint “n\u6d4b\u8bd5\u70b9:”))
\n (setq p (trans p 1 0))
\n (setq p (vlax-curve-getclosestpointto e p))
\n (setq param (vlax-curve-getParamAtPoint e p))
\n (setq f1 (vlax-curve-getFirstDeriv e param))
\n (setq f2 (vlax-curve-getSecondDeriv e param))
\n (Ent:make_line p (mapcar ‘+ p f1))
\n (Ent:make_line p (mapcar ‘+ p f2))
\n )
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u6c42\u692d\u5706(\u5e73\u9762)\u5916\u4e00\u70b9\u5230\u692d\u5706\u7684\u5207\u7ebf
\n;;; \u8f93\u5165: \u692d\u5706\u5916\u4e00\u70b9Point,\u692d\u5706\u4e2d\u5fc3C,\u692d\u5706\u534a\u957f\u8f74a,\u534a\u77ed\u8f74b,\u548c\u692d\u5706\u7684\u65cb\u8f6c\u89d2
\n;;; \u8f93\u51fa: \u6b64\u70b9\u5230\u4e0e\u692d\u5706\u76f8\u5207\u7684\u5207\u70b9(\u4e00\u4e2a\uff0c\u4e24\u4e2a\u6216\u8005nil)
\n;;;=====================================================================
\n(defun ELL:PointTangentTo (Point C a b ang \/ AA BB K1 K2 KK P X Y Z XX YY)
\n (setq Point (mapcar ‘- Point C))
\n (setq z (polar ‘(0 0 0) ang a))
\n (setq P (trans point 0 z T))
\n (setq x (caddr p))
\n (setq y (car p))
\n (if (equal y 0 1e-8)
\n (if (> (abs x) a)
\n (progn
\n (setq kk (\/ a x))
\n (setq xx (* a kk))
\n (setq yy (* b (sqrt (- 1 (* kk kk)))))
\n (list
\n (mapcar ‘+ C (trans (list yy 0 xx) z 0 T))
\n (mapcar ‘+ C (trans (list (- yy) 0 xx) z 0 T))
\n )
\n )
\n )
\n (progn
\n (setq aa (* a a))
\n (setq bb (* b b))
\n (setq xx (* x x))
\n (setq yy (* y y))
\n (setq k1 (+ (* aa yy) (* bb xx)))
\n (setq k2 (- k1 (* aa bb)))
\n (if (> k2 0)
\n (progn
\n (defun GetTan (A B C bb K1 X Y Z KK \/ d1 k4 k5 s1 x1 y1 p1)
\n (setq d1 (+ (* bb x) kk))
\n (setq k4 (\/ (* d1 x) k1))
\n (setq k5 (\/ (* d1 a) k1))
\n (setq s1 (atan (\/ (* b (- 1 k4)) y) k5))
\n (setq x1 (* a (cos s1)))
\n (setq y1 (* b (sin s1)))
\n (setq P1 (trans (list y1 0 x1) z 0 T))
\n (setq p1 (mapcar ‘+ P1 C))
\n )
\n (setq kk (* (sqrt k2) (abs y)))
\n (list (GetTan A B C bb K1 X Y Z kk)
\n (GetTan A B C bb K1 X Y Z (- kk))
\n )
\n )
\n )
\n )
\n )
\n)<\/p>\n

;;; \u692d\u5706\u7684\u5207\u7ebf\u51fd\u6570\u6d4b\u8bd5
\n(defun C:PointTangentTo (\/ A ANG B C DXF ENT MAJ PNT RET SEL)
\n (if (setq sel (ssget “:S” ‘((0 . “ELLIPSE”))))
\n (progn
\n (setq ent (ssname sel 0))
\n (setq dxf (entget ent))
\n (setq maj (cdr (assoc 11 dxf)))
\n (setq a (distance ‘(0 0 0) maj))
\n (setq b (* a (cdr (assoc 40 dxf))))
\n (setq c (cdr (assoc 10 dxf)))
\n (setq ang (angle ‘(0 0 0) maj))
\n (while (setq Pnt (getpoint “n\u9009\u53d6\u70b9: “))
\n (setq Pnt (trans Pnt 1 0))
\n (setq ret (ELL:PointTangentTo Pnt C a b ang))
\n (foreach p ret
\n (Ent:Make_line p Pnt)
\n )
\n )
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u5173\u4e8e\u692d\u5706\u7684\u5171\u5207\u7ebf\u95ee\u9898\u8bf7\u53c2\u8003\uff1a
\n;;; http:\/\/bbs.mjtd.com\/forum.php?mod=viewthread&tid=82900
\n;;; \u53e6\u5916\u53ef\u53c2\u8003\u6211\u7684\u9644\u4ef6: ellipse-tan-solve1.LSP
\n;;;=====================================================================<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u6c42\u692d\u5706\u4e0e\u76f4\u7ebf\u7684\u4ea4\u70b9(\u8ba1\u7b97\u51e0\u4f55\u65b9\u5f0f1)
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u957f\u8f74a,\u77ed\u8f74b\uff0c\u4e24\u70b9P1,P2.
\n;;; \u8f93\u51fa: \u76f4\u7ebfP1P2\u4e0e\u692d\u5706\u7684\u4ea4\u70b9\u3002
\n;;; \u53c2\u8003: http:\/\/bbs.mjtd.com\/thread-62003-2-1.html
\n;;; RootOf((M^2*a^2+N^2*b^2)*_Z^2-M^2*a^2+L^2+2*L*N*b*_Z)*b
\n;;;=====================================================================
\n(Defun ELL:Inters_Ellipse_Line (a b P1 P2 \/ D E K L M N P PA PB X1 X2 Y1 Y2)
\n (setq k (\/ b (float a)))
\n (setq X1 (car P1))
\n (setq X2 (car P2))
\n (setq Y1 (\/ (cadr P1) k))
\n (setq Y2 (\/ (cadr P2) k))
\n (Setq M (- Y1 Y2)) ;\u76f4\u7ebf\u65b9\u7a0b\u7cfb\u6570M
\n (Setq N (- X2 X1)) ;\u76f4\u7ebf\u65b9\u7a0b\u7cfb\u6570N
\n (setq D (\/ (- (* Y2 X1) (* Y1 X2)) (sqrt (+ (* M M) (* N N))))) ;\u5782\u8ddd
\n (setq e (angle (list x1 y1) (list x2 y2))) ;\u76f4\u7ebf\u7684\u4e0eX\u8f74\u7ebf\u7684\u4ea4\u89d2
\n (setq p (polar ‘(0 0) (- e (* pi 0.5)) d)) ;\u5706\u5fc3\u5230\u76f4\u7ebf\u7684\u5782\u8db3
\n (setq d (abs d))
\n (if (equal d a 1e-8) ;\u5982\u679c\u5782\u8ddd\u7b49\u4e8e\u534a\u5f84
\n (list (list (car p) (* k (cadr p)))) ;\u76f8\u5207
\n (if (< d a) ;\u5982\u679c\u5782\u8ddd\u5c0f\u4e8e\u534a\u5f84
\n (progn
\n (setq L (sqrt (* (+ a d)(- a d)))) ;\u534a\u5f26\u957f
\n (setq Pa (polar p e (- L)))
\n (setq Pb (polar p e L))
\n (setq pa (list (car Pa) (* k (cadr Pa))))
\n (setq pb (list (car Pb) (* k (cadr Pb))))
\n (list pa pb) ;\u6709\u4e24\u4e2a\u4ea4\u70b9
\n )
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u6c42\u692d\u5706\u4e0e\u76f4\u7ebf\u7684\u4ea4\u70b9(\u8ba1\u7b97\u51e0\u4f55\u65b9\u5f0f2,\u4f3c\u4e4e\u6bd4\u65b9\u5f0f1\u6162)
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u957f\u8f74a,\u77ed\u8f74b\uff0c\u4e24\u70b9P1,P2.
\n;;; \u8f93\u51fa: \u76f4\u7ebfP1P2\u4e0e\u692d\u5706\u7684\u4ea4\u70b9\u3002
\n;;;=====================================================================
\n(Defun ELL:Inters_Ellipse_Line_1 (a b P1 P2 \/ K1 K2 K3 M N L MA NB PS X X1 X2 Y Y1 Y2)
\n (Setq X1 (Car P1))
\n (Setq Y1 (Cadr P1))
\n (Setq X2 (Car P2))
\n (Setq Y2 (Cadr P2))
\n (Setq M (float (- Y1 Y2))) ;\u76f4\u7ebf\u65b9\u7a0b\u7cfb\u6570M
\n (Setq N (float (- X2 X1))) ;\u76f4\u7ebf\u65b9\u7a0b\u7cfb\u6570N
\n (Setq L (float (- (* Y2 X1) (* Y1 X2)))) ;\u76f4\u7ebf\u65b9\u7a0b\u7cfb\u6570L
\n (setq Nb (* N b))
\n (if (equal M 0 1e-8) ;\u6c34\u5e73\u76f4\u7ebf
\n (cond
\n ( (equal (setq K1 (* (+ Nb L) (- Nb L))) 0 1e-8)
\n (list (list 0 (- (\/ L N))))
\n )
\n ( (> K1 0)
\n (setq x (\/ (* a (sqrt k1)) Nb))
\n (setq y (- (\/ L N)))
\n (list (list x y) (list (- x) y))
\n )
\n )
\n (progn
\n (setq Ma (* M a))
\n (setq k1 (+ (* Ma Ma) (* Nb Nb)))
\n (setq k2 (* 2 L Nb))
\n (setq k3 (- (* L L) (* Ma Ma)))
\n (foreach e (Math:Quadratic_Equation_1 k1 k2 k3)
\n (setq x (\/ (+ L (* N e b)) (- M)))
\n (setq y (* e b))
\n (setq ps (cons (list x y) ps))
\n )
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u6c42\u5e73\u9762\u692d\u5706\u4e0e\u76f4\u7ebf\u7684\u4ea4\u70b9
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u4e2d\u5fc3Center,\u957f\u8f74\u65b9\u5411major,\u692d\u7387ratio\uff0c\u4e24\u70b9P1,P2.
\n;;; \u8f93\u51fa: \u76f4\u7ebfP1P2\u4e0e\u692d\u5706\u7684\u4ea4\u70b9\u3002
\n;;;=====================================================================
\n(Defun ELL:Inters_Ellipse_Line_2D (Center major Ratio P1 P2 \/ v1 v2 a b s)
\n (setq v1 (mapcar ‘- p1 center))
\n (setq v2 (mapcar ‘- p2 center))
\n (setq v1 (trans v1 0 major T))
\n (setq v2 (trans v2 0 major T))
\n (setq v1 (list (caddr v1) (car v1)))
\n (setq v2 (list (caddr v2) (car v2)))
\n (setq a (distance ‘(0 0 0) major))
\n (setq b (* ratio a))
\n (foreach p (ELL:Inters_Ellipse_Line_1 a b v1 v2)
\n (setq p (trans (list (cadr p) 0 (car p)) major 0 T))
\n (setq p (mapcar ‘+ center p))
\n (setq s (cons p s))
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u6c42\u7a7a\u95f4\u692d\u5706\u4e0e\u76f4\u7ebf\u7684\u4ea4\u70b9\uff08\u6ce8\u610f\uff0c\u8fd9\u4e2a\u4ea4\u70b9\u4e3a\u5728\u692d\u5706\u5e73\u9762\u4e0a\u7684\u4ea4\u70b9\uff09
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u4e2d\u5fc3Center,\u957f\u8f74\u65b9\u5411major,\u692d\u7387ratio,\u6cd5\u7ebfNormal,\u4e24\u70b9P1,P2.
\n;;; \u8f93\u51fa: \u76f4\u7ebfP1P2\u4e0e\u692d\u5706\u7684\u4ea4\u70b9\u3002
\n;;;=====================================================================
\n(Defun ELL:Inters_Ellipse_Line_3D (Center major Ratio Normal P1 P2 \/ A B M1 M2 S V1 V2)
\n (setq v1 (mapcar ‘- p1 center))
\n (setq v2 (mapcar ‘- p2 center))
\n (setq m1 (ELL:RotationMatrix major Normal))
\n (setq m2 (cadr m1))
\n (setq m1 (car m1))
\n (setq v1 (mat:mxv m2 v1))
\n (setq v2 (mat:mxv m2 v2))
\n (setq a (distance ‘(0 0 0) major))
\n (setq b (* ratio a))
\n (foreach p (ELL:Inters_Ellipse_Line_1 a b v1 v2)
\n (setq p (mat:mxv m1 (append p ‘(0))))
\n (setq p (mapcar ‘+ center p))
\n (setq s (cons p s))
\n )
\n)<\/p>\n

;;; \u692d\u5706\u7684\u4e0e\u76f4\u7ebf\u76f8\u4ea4\u51fd\u6570\u7684\u6d4b\u8bd5
\n(defun C:iel (\/ p1 p2 sel ent dxf cen maj rat nrm a b ret)
\n (initget 1)
\n (setq P1 (getpoint “n\u9009\u53d6\u70b91: “))
\n (initget 1)
\n (setq P2 (getpoint P1 “n\u9009\u53d6\u70b92: “))
\n (setq p1 (trans p1 1 0))
\n (setq p2 (trans p2 1 0))
\n (Ent:Make_Line p1 p2)
\n (if (setq sel (ssget “:S” ‘((0 . “ELLIPSE”))))
\n (progn
\n (setq ent (ssname sel 0))
\n (setq dxf (entget ent))
\n (setq cen (cdr (assoc 10 dxf)))
\n (setq maj (cdr (assoc 11 dxf)))
\n (setq rat (cdr (assoc 40 dxf)))
\n (setq Nrm (cdr (assoc 210 DXF)))
\n (setq a (distance ‘(0 0 0) maj))
\n (setq b (* rat a))
\n (MISC:test 100
\n ‘((ELL:Inters_Ellipse_Line_2d cen maj rat P1 P2)
\n (ELL:Inters_Ellipse_Line_3d cen maj rat Nrm P1 P2)))
\n ;(setq ret (ELL:Inters_Ellipse_Line_2d cen maj rat P1 P2))
\n (setq ret (ELL:Inters_Ellipse_Line_3d cen maj rat Nrm P1 P2))
\n (and ret (mapcar ‘Ent:Make_Point ret))
\n )
\n )
\n)[\/codesyntax]
\n\u516d\u3001\u4e0e\u692d\u5706\u7684\u6700\u8fd1\u70b9\u548c\u6700\u8fdc\u70b9
\n[codesyntax lang=”lisp”];;;=====================================================================
\n;;; \u6c42\u5e73\u9762\u4e0a\u4e00\u70b9\u5230\u692d\u5706\u7684\u8ddd\u79bb\u7684\u6781\u503c\uff08\u5305\u62ec\u6700\u5c0f\u503c\u548c\u6700\u5927\u503c\uff09\u65b9\u5f0f1
\n;;; \u8f93\u5165\uff1a\u692d\u5706\u7684\u957f\u8f74a\uff0c\u77ed\u8f74b\u548c\u5e73\u9762\u7684\u4e00\u70b9P
\n;;; \u8f93\u51fa\uff1a\u692d\u5706\u7684\u8ddf\u5e73\u9762\u7684P\u70b9\u8ddd\u79bb\u4e3a\u6781\u503c\u7684\u70b9
\n;;;=====================================================================
\n(defun ELL:GetExtremumDist (a b P \/ am cc K1 K2 K3 m n v x y ps)
\n (setq m (car p))
\n (setq n (cadr p))
\n (setq cc (* (+ a b) (- a b)))
\n (setq k1 (* n b))
\n (setq am (* a m))
\n (setq k2 (+ am cc))
\n (setq k2 (+ k2 k2))
\n (setq k3 (- am cc))
\n (setq k3 (+ k3 k3))
\n (foreach s (Math:Quartic_Equation k1 k2 0 k3 (- k1))
\n (if (equal (cadr s) 0 1e-8)
\n (progn
\n (setq s (car s))
\n (setq v (* s s))
\n (setq x (\/ (* a (- 1 v)) (1+ v)))
\n (setq y (\/ (* b (+ s s)) (1+ v)))
\n (setq ps (cons (list x y) ps))
\n )
\n )
\n )
\n (if (equal k1 0 1e-8)
\n (setq ps (cons (list (- a) 0) ps))
\n (reverse ps)
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u6c42\u5e73\u9762\u4e0a\u4e00\u70b9\u5230\u692d\u5706\u7684\u8ddd\u79bb\u7684\u6781\u503c\uff08\u5305\u62ec\u6700\u5c0f\u503c\u548c\u6700\u5927\u503c\uff09\u65b9\u5f0f2
\n;;; \u8f93\u5165\uff1a\u692d\u5706\u7684\u957f\u8f74a\uff0c\u77ed\u8f74b\u548c\u5e73\u9762\u7684\u4e00\u70b9P
\n;;; \u8f93\u51fa\uff1a\u692d\u5706\u7684\u8ddf\u5e73\u9762\u7684P\u70b9\u8ddd\u79bb\u4e3a\u6781\u503c\u7684\u70b9
\n;;;=====================================================================
\n(defun ELL:GetExtremumDist1 (a b P \/ c cc e ee f K1 K2 K3 K4 K5 m n x y ps)
\n (setq m (car p))
\n (setq n (cadr p))
\n (if (equal m 0 1e-10)
\n (list (list 0 (- b)) (list 0 b))
\n (progn
\n (setq cc (* (+ a b) (- a b)))
\n (setq c (sqrt cc))
\n (setq e (\/ c a))
\n (setq f (\/ b a))
\n (setq ee (* e e))
\n (setq k1 (* ee ee))
\n (setq k2 (* -2 m ee))
\n (setq k3 (- (+ (* n n f f) (* m m)) (* ee cc)))
\n (setq k4 (* 2 m cc))
\n (setq k5 (- (* a a m m)))
\n (foreach s (Math:Quartic_Equation k1 k2 k3 k4 k5)
\n (if (equal (cadr s) 0 1e-6)
\n (progn
\n (setq x (car s))
\n (setq y (\/ (* n b b) (- (\/ (* m a a) x) cc)))
\n (setq ps (cons (list x y) ps))
\n )
\n )
\n )
\n ps
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u6c42\u7a7a\u95f4\u4e0a\u4e00\u70b9\u5230\u7a7a\u95f4\u692d\u5706\u7684\u8ddd\u79bb\u7684\u6781\u503c\uff08\u5305\u62ec\u6700\u5c0f\u503c\u548c\u6700\u5927\u503c\uff09
\n;;; \u8f93\u5165: \u692d\u5706\u7684\u4e2d\u5fc3Center,\u957f\u8f74\u77e2\u91cfmajor,\u692d\u7387ratio,\u6cd5\u7ebfNormal,\u7a7a\u95f4\u4e00\u70b9P.
\n;;; \u8f93\u51fa: \u692d\u5706\u7684\u8ddf\u7a7a\u95f4\u7684P\u70b9\u8ddd\u79bb\u4e3a\u6781\u503c\u7684\u70b9
\n;;;=====================================================================
\n(defun ELL:GetExtremumDist_3D (Center major Ratio Normal P \/ A B M1 M2 S V1)
\n (setq v1 (mapcar ‘- p center))
\n (setq m1 (ELL:RotationMatrix major Normal))
\n (setq m2 (cadr m1))
\n (setq m1 (car m1))
\n (setq v1 (mat:mxv m2 v1))
\n (setq a (distance ‘(0 0 0) major))
\n (setq b (* ratio a))
\n (foreach n (ELL:GetExtremumDist a b v1)
\n (setq n (mat:mxv m1 (append n ‘(0))))
\n (setq n (mapcar ‘+ center n))
\n (setq s (cons n s))
\n )
\n)<\/p>\n

;;; \u6d4b\u8bd5\u6c42\u6781\u503c\u8ddd\u79bb\u7a0b\u5e8f
\n(defun C:GetExtremumDist (\/ p sel ent dxf cen maj rat nrm a b)
\n (initget 1)
\n (setq P (getpoint “n\u9009\u53d6\u70b91: “))
\n (setq p (trans p 1 0))
\n (Ent:Make_Point p)
\n (if (setq sel (ssget “:S” ‘((0 . “ELLIPSE”))))
\n (progn
\n (setq ent (ssname sel 0))
\n (setq dxf (entget ent))
\n (setq cen (cdr (assoc 10 dxf)))
\n (setq maj (cdr (assoc 11 dxf)))
\n (setq rat (cdr (assoc 40 dxf)))
\n (setq Nrm (cdr (assoc 210 DXF)))
\n (setq a (distance ‘(0 0 0) maj))
\n (setq b (* rat a))
\n;;; (misc:test
\n;;; 1001
\n;;; ‘((ELL:GetExtremumDist1 a b P)
\n;;; (ELL:GetExtremumDist a b P)
\n;;; (vlax-curve-getclosestpointto ent p)
\n;;; )
\n;;; )
\n ;(mapcar ‘Ent:Make_Point (ELL:GetExtremumDist1 a b P))
\n (mapcar ‘Ent:Make_Point (ELL:GetExtremumDist_3D cen maj rat Nrm P))
\n )
\n )
\n)[\/codesyntax]
\n\u4e03 \u692d\u5706\u7684\u5305\u56f4\u76d2\u548c\u6700\u5c0f\u5305\u56f4\u76d2
\n[codesyntax lang=”lisp”];;;=====================================================================
\n;;;\u529f\u80fd\uff1a\u83b7\u53d6\u692d\u5706\u7684\u6700\u5c0f\u5305\u56f4\u76d2(\u672a\u5b8c\u6574\u6d4b\u8bd5\uff0c\u53ef\u80fd\u5bf9\u4e8e\u67d0\u4e9b\u53d8\u5f62\u692d\u5706\u65e0\u6548)
\n;;;\u53c2\u6570\uff1a\u692d\u5706\u5b9e\u4f53
\n;;;\u8fd4\u56de\uff1a\u5305\u56f4\u8fd9\u4e2a\u692d\u5706\u7684\u6700\u5c0f\u77e9\u5f62\u7684\u56db\u4e2a\u89d2\u70b9
\n;;;=====================================================================
\n(defun ELL:GetMinBox (ent \/ CEN DXF MAJ Pt1 Pt2 Pt3 Pt4 PTB PTD)
\n (setq dxf (entget ent))
\n (setq cen (cdr (assoc 10 dxf)))
\n (setq maj (cdr (assoc 11 dxf)))
\n (setq ptb (vlax-curve-getPointAtParam ent (* pi 0.5)))
\n (setq ptd (vlax-curve-getPointAtParam ent (* pi 1.5)))
\n (setq pt1 (mapcar ‘- ptd maj))
\n (setq pt2 (mapcar ‘+ ptd maj))
\n (setq pt3 (mapcar ‘+ ptb maj))
\n (setq pt4 (mapcar ‘- ptb maj))
\n (list pt1 pt2 pt3 pt4)
\n)<\/p>\n

;;;=====================================================================
\n;;;\u529f\u80fd\uff1a\u83b7\u53d6\u692d\u5706OCS\u7684\u5305\u56f4\u76d2
\n;;;\u53c2\u6570\uff1a\u692d\u5706\u7684\u4e2d\u5fc3\uff0c\u534a\u957f\u8f74\uff0c\u534a\u77ed\u8f74\uff0c\u65cb\u8f6c\u89d2
\n;;;\u8fd4\u56de\uff1a\u5305\u56f4\u8fd9\u4e2a\u692d\u5706\u7684OCS\u65b9\u5411\u7684\u56db\u4e2a\u89d2\u70b9
\n;;;=====================================================================
\n(defun ELL:GetOCSBox (C a b ang \/ l x p 90D LL LR UL UR)
\n (setq 90d (* pi 0.5))
\n (foreach n (list 0 90d)
\n (setq x (- n ang))
\n (setq x (atan (* a (sin x)) (* b (cos x))))
\n (setq x (+ x 90d))
\n (setq p (list (* a (cos x)) (* b (sin x))))
\n (setq p (GEO:Rot2D p ‘(0 0) ang))
\n (setq l (cons (mapcar ‘+ C p) l))
\n (setq l (cons (mapcar ‘- C p) l))
\n )
\n (setq ll (apply ‘mapcar (cons ‘min l)))
\n (setq ur (apply ‘mapcar (cons ‘max l)))
\n (setq lr (list (car ur) (cadr ll)))
\n (setq ul (list (car ll) (cadr ur)))
\n (list ll lr ur ul)
\n)<\/p>\n

;;;=====================================================================
\n;;;\u529f\u80fd\uff1a\u83b7\u53d6\u692d\u5706\u7684\u5305\u56f4\u76d2\uff08\u6b64\u5305\u56f4\u76d2\u65b9\u5411\u5e73\u884c\u4e8e\u5f53\u524d\u5750\u6807\u7cfb\uff09
\n;;;\u53c2\u6570\uff1a\u692d\u5706\u5b9e\u4f53
\n;;;\u8fd4\u56de\uff1a\u5305\u56f4\u8fd9\u4e2a\u692d\u5706\u7684\u5e73\u884c\u5f53\u524d\u5750\u6807\u7cfb\u65b9\u5411\u7684\u56db\u4e2a\u89d2\u70b9
\n;;;=====================================================================
\n(defun ELL:GetBoundingBox (ent \/ lst obj pta ptb C Cen Maj Mnr Ret)
\n (setq obj (vlax-ename->vla-object ent))
\n (if (= 1 (getvar ‘WORLDUCS))
\n (progn
\n (setq lst (vla-getboundingbox obj ‘pta ‘ptb))
\n (setq pta (vlax-safearray->list pta))
\n (setq ptb (vlax-safearray->list ptb))
\n (list
\n (list (car pta) (cadr pta) 0)
\n (list (car ptb) (cadr pta) 0)
\n (list (car ptb) (cadr ptb) 0)
\n (list (car pta) (cadr ptb) 0)
\n )
\n )
\n (progn
\n (setq cen (vlax-get obj ‘center))
\n (setq maj (vlax-get obj ‘MajorAxis))
\n (setq mnr (vlax-get obj ‘MinorAxis))
\n (setq C (trans cen 0 1))
\n (setq pta (mapcar ‘+ C (trans maj 0 1 T)))
\n (setq ptb (mapcar ‘+ C (trans mnr 0 1 T)))
\n (if (setq ret (ELL:2ConjugateDiameters C pta ptb))
\n (mat:translist (apply ‘ELL:GetOCSBox ret) 1 0 nil)
\n )
\n )
\n )
\n)<\/p>\n

;;;\u6d4b\u8bd5\u692d\u5706\u7684\u5305\u56f4\u76d2\u7a0b\u5e8f
\n(defun c:test3 (\/ i sel ent)
\n (setq i 0)
\n (if (setq sel (ssget ‘((0 . “ELLIPSE”))))
\n (repeat (sslength sel)
\n (setq ent (ssname sel i))
\n (Ent:Make_Poly (ELL:GetBoundingBox ent))
\n (setq i (1+ i))
\n )
\n )
\n (princ)
\n)<\/p>\n

;;;\u6d4b\u8bd5\u692d\u5706\u7684\u6700\u5c0f\u5305\u56f4\u76d2\u7a0b\u5e8f
\n(defun c:test4 (\/ i sel ent ret)
\n (setq i 0)
\n (if (setq sel (ssget ‘((0 . “ELLIPSE”))))
\n (repeat (sslength sel)
\n (setq ent (ssname sel i))
\n (setq ret (ELL:getMinBox ent))
\n (Ent:Make_Poly ret)
\n (setq i (1+ i))
\n )
\n )
\n (princ)
\n)[\/codesyntax]
\n\u516b\u3001\u692d\u5706\u6784\u5efa\u4e0e\u4f5c\u56fe\u95ee\u9898
\n[codesyntax lang=”lisp”];;;=====================================================================
\n;;; Given a pair of conjugate diameters, construct an ellipse
\n;;; \u529f\u80fd: \u5df2\u77e5\u4e24\u5171\u8f6d\u534a\u8f74\u4f5c\u692d\u5706
\n;;; \u8f93\u5165: \u5171\u8f6d\u8f74\u7684\u4ea4\u70b9C(\u5373\u692d\u5706\u5706\u5fc3)\u3001\u5171\u8f6d\u534a\u8f74\u7684\u4e24\u7aef\u70b9P,Q
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u692d\u5706\u7684\u57fa\u672c\u8981\u7d20\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun ELL:2ConjugateDiameters (C P Q \/ a b K M R U W)
\n (if (not (LINE:Colinearity C P Q))
\n (progn
\n (setq C (list (car C) (cadr C)))
\n (setq P (list (car P) (cadr P)))
\n (setq Q (list (car Q) (cadr Q)))
\n (setq K (GEO:Rot90 C C Q))
\n (setq M (GEO:Midpoint K P))
\n (setq R (distance M C))
\n (setq U (polar M (angle M P) R))
\n (setq W (polar M (angle M K) R))
\n (setq a (distance W P))
\n (setq b (distance U P))
\n (list C a b (angle C U))
\n )
\n )
\n)
\n;|
\n;;;\u6d4b\u8bd5\u5171\u8f6d\u534a\u5f84\u7684\u692d\u5706
\n(defun C:CDD (\/ c p q ret ent obj)
\n (initget 1)
\n (setq C (getpoint “n\u4e2d\u5fc3”))
\n (initget 1)
\n (setq P (getpoint C “n\u534a\u5f841”))
\n (initget 1)
\n (setq Q (getpoint C “n\u534a\u5f842”))
\n (foreach n (list C P Q)
\n (Ent:make_Point (trans n 1 0))
\n )
\n (if (setq ret (ELL:2ConjugateDiameters C P Q))
\n (progn
\n (setq ent (apply ‘Ent:Make_Ellipse ret))
\n (setq obj (vlax-ename->vla-object ent))
\n (vla-transformby obj (vlax-tmatrix (mat:u2w)))
\n )
\n )
\n)|;<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse with a given axis to pass through a given point
\n;;; \u529f\u80fd: \u5df2\u77e5\u692d\u5706\u7684\u4e00\u4e2a\u957f\u8f74\uff0c\u548c\u692d\u5706\u4e0a\u7684\u4e00\u70b9
\n;;; \u8f93\u5165: \u957f\u8f74\u7684\u4e24\u4e2a\u7aef\u70b9M\u3001N\u548c\u692d\u5706\u4e0a\u7684\u4e00\u70b9P
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u692d\u5706\u7684\u57fa\u672c\u8981\u7d20\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun ELL:Axis_Point (M N P \/ C a b Maj Vec x y d)
\n (setq C (Geo:Midpoint M N))
\n (setq A (distance C M))
\n (setq Maj (mapcar ‘- M C))
\n (setq vec (trans (mapcar ‘- P C) 0 Maj T)) ;???
\n (setq x (caddr vec))
\n (setq y (car vec))
\n (if (not (>= (abs x) a))
\n (progn
\n (setq d (sqrt (* (+ a x) (- a x))))
\n (setq b (abs (* (\/ y d) a)))
\n (list C a b (angle C M))
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse with a given axis to touch a given line
\n;;; \u529f\u80fd: \u5df2\u77e5\u692d\u5706\u7684\u4e00\u4e2a\u534a\u957f\u8f74\uff0c\u548c\u692d\u5706\u5916\u7684\u4e00\u6761\u5207\u7ebf
\n;;; \u8f93\u5165: \u534a\u957f\u8f74\u7684\u4e24\u4e2a\u7aef\u70b9M\u3001N\u548c\u692d\u5706\u4e0a\u7684\u4e00\u70b9P
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u692d\u5706\u7684\u57fa\u672c\u8981\u7d20\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun ELL:Axis_Tangent (M N P Q \/ C A Ax an v1 v2 y1 x1 y2 x2 d1 d2 d3)
\n (setq C (Geo:Midpoint M N))
\n (setq A (distance C M))
\n (setq Ax (mapcar ‘- M C))
\n (setq an (angle C M))
\n (setq v1 (trans (mapcar ‘- P C) 0 Ax T)) ;???
\n (setq v2 (trans (mapcar ‘- Q C) 0 Ax T)) ;???
\n (setq y1 (car v1))
\n (setq x1 (caddr v1))
\n (setq y2 (car v2))
\n (setq x2 (caddr v2))
\n (setq d1 (- (* x1 y2) (* x2 y1)))
\n (setq d2 (- y1 y2))
\n (setq d3 (- (* D1 D1) (* d2 d2 a a)))
\n (if (and (not (equal x1 x2 1e-14)) (> d3 0))
\n (list C a (abs (\/ (sqrt d3) (- x1 x2))) an)
\n )
\n)<\/p>\n

(defun ELL:Axis_Tangent_1 (M N P Q \/ C A Maj I L x Ang G H J)
\n (setq C (Geo:Midpoint M N))
\n (setq A (distance C M))
\n (setq Maj (mapcar ‘- M C))
\n (if (setq I (inters M N P Q nil))
\n (progn
\n (setq L (distance C I))
\n (setq x (\/ (* a a) L))
\n (setq ang (angle C I))
\n (setq G (polar C ang (abs x)))
\n (setq H (polar G (+ ang (* pi 0.5)) a))
\n (setq J (inters G H P Q nil))
\n (if J
\n (ELL:Axis_Point M N J)
\n )
\n )
\n (progn
\n (setq ang (angle C M))
\n (setq G (polar C (+ ang (* pi 0.5)) A))
\n (setq H (inters C G P Q nil))
\n (if H
\n (list C a (distance C H) ang)
\n )
\n )
\n )
\n)<\/p>\n

(defun c:Axis_Tangent ()
\n (initget 1)
\n (setq M (getpoint “n\u7aef\u70b91”))
\n (initget 1)
\n (setq N (getpoint M “n\u7aef\u70b92”))
\n (initget 1)
\n (setq P (getpoint “n\u70b91\uff1a”))
\n (initget 1)
\n (setq Q (getpoint P “n\u70b92\uff1a”))
\n (setq M (trans M 1 0))
\n (setq N (trans N 1 0))
\n (setq P (trans P 1 0))
\n (setq Q (trans Q 1 0))
\n (mapcar ‘Ent:make_Point (list M N P Q))
\n (Ent:make_line P Q)
\n ;(setq E (ELL:Axis_Point M N P))
\n (MISC:test 1001 ‘((ELL:Axis_Tangent M N P Q) (ELL:Axis_Tangent_1 M N P Q)))
\n (setq E (ELL:Axis_Tangent M N P Q))
\n (and E (apply ‘Ent:Make_Ellipse E))
\n (setq E (ELL:Axis_Tangent_1 M N P Q))
\n (and E (apply ‘Ent:Make_Ellipse E))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, Given the directions of a pair of conjugate
\n;;; diameters, a tangent and its point of contact being given
\n;;; \u529f\u80fd: \u5df2\u77e5\u692d\u5706\u7684\u4e24\u4e2a\u5171\u8f6d\u8f74\u65b9\u5411\uff0c\u4e00\u6761\u5207\u7ebf\u548c\u8fd9\u4e2a\u5207\u70b9
\n;;; \u8f93\u5165: \u4e24\u6761\u5171\u8f6d\u8f74JK\u548cMN,\u5207\u7ebfPQ\u5e76\u5207\u4e8eP\u70b9
\n;;; \u8f93\u51fa: \u6210\u529f\u8fd4\u56de\u692d\u5706\u7684\u57fa\u672c\u8981\u7d20\uff0c\u5426\u5219\u8fd4\u56denil
\n;;;=====================================================================
\n(defun ELL:2Directions_Tangent_Point (J K M N P Q \/ C G H A B E F U W r s x y)
\n (if (and (setq C (inters J K M N nil))
\n (setq G (inters P Q J K nil))
\n (setq H (inters P Q M N nil))
\n )
\n (progn
\n (setq A (angle C G))
\n (setq B (angle C H))
\n (setq U (inters P (polar P B 1) J K nil))
\n (setq W (inters P (polar P A 1) M N nil))
\n (setq r (distance C G))
\n (setq s (distance C H))
\n (setq x (distance C U))
\n (setq y (distance C W))
\n (if (and (< x r) (< y s))
\n (progn
\n (setq x (sqrt (* x r)))
\n (setq y (sqrt (* y s)))
\n (setq E (polar C A X))
\n (setq F (polar C B Y))
\n (ELL:2ConjugateDiameters C E F)
\n )
\n )
\n )
\n )
\n)<\/p>\n

(defun c:2Directions_Tangent_Point ()
\n (initget 1)
\n (setq J (getpoint “n\u7aef\u70b91”))
\n (initget 1)
\n (setq K (getpoint J “n\u7aef\u70b92”))
\n (initget 1)
\n (setq M (getpoint “n\u7aef\u70b91”))
\n (initget 1)
\n (setq N (getpoint M “n\u7aef\u70b92”))
\n (initget 1)
\n (setq P (getpoint “n\u5207\u70b9\uff1a”))
\n (initget 1)
\n (setq Q (getpoint P “n\u53e6\u4e00\u70b9\uff1a”))
\n (setq J (trans J 1 0))
\n (setq K (trans K 1 0))
\n (setq M (trans M 1 0))
\n (setq N (trans N 1 0))
\n (setq P (trans P 1 0))
\n (setq Q (trans Q 1 0))
\n (mapcar ‘Ent:make_Point (list J K M N P Q))
\n (Ent:make_line P Q)
\n (Ent:make_line J K)
\n (Ent:make_line M N)
\n (setq E (ELL:2Directions_Tangent_Point J K M N P Q))
\n (and E (apply ‘Ent:Make_Ellipse E))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, the center, two points on the curve and
\n;;; directions of a pair of conjugate diameters being given.
\n;;;=====================================================================
\n(defun ELL:2Directions_2Points (C M N P Q \/ A B D E F G I P1 Q1 R S U W X Y Z)
\n (if (and (inters P Q C M nil) (inters P Q C N nil))
\n (progn
\n (setq x (angle C M))
\n (setq y (angle C N))
\n (setq D (inters P (polar P x 1) C N nil))
\n (setq S (inters Q (polar Q y 1) C M nil))
\n (setq E (inters P D Q S nil))
\n (setq P1 (polar D (angle P D) (distance P D)))
\n (setq Q1 (polar S (angle Q S) (distance Q S)))
\n (setq F (polar S (angle P Q) 1))
\n (setq F (inters S F D E nil))
\n (setq G (polar S (angle P1 Q1) 1))
\n (setq G (inters S G D E nil))
\n (setq z (sqrt (* (distance E F) (distance E G))))
\n (setq i (angle E P))
\n (setq r (distance P D))
\n (setq a (sqrt (+ (* r r) (* z z))))
\n (setq U (polar C I a))
\n (setq b (\/ (* (distance C D) a) z))
\n (setq W (polar C (angle C D) b))
\n (ELL:2ConjugateDiameters C U W)
\n )
\n )
\n)<\/p>\n

(defun c:2Directions_2Points ()
\n (initget 1)
\n (setq C (getpoint “n\u4e2d\u5fc3: “))
\n (initget 1)
\n (setq M (getpoint C “n\u7aef\u70b91”))
\n (initget 1)
\n (setq N (getpoint C “n\u7aef\u70b92”))
\n (initget 1)
\n (setq P (getpoint “n\u4e00\u70b9\uff1a”))
\n (initget 1)
\n (setq Q (getpoint P “n\u53e6\u4e00\u70b9\uff1a”))
\n (setq C (trans C 1 0))
\n (setq M (trans M 1 0))
\n (setq N (trans N 1 0))
\n (setq P (trans P 1 0))
\n (setq Q (trans Q 1 0))
\n (mapcar ‘Ent:make_Point (list C M N P Q))
\n (setq K (ELL:2Directions_2Points C M N P Q))
\n (and K (apply ‘Ent:Make_Ellipse K))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, the center, the directions of the major axis
\n;;; and two tangents being given
\n;;;=====================================================================
\n(defun ELL:MajorDirection_2Tangents (C M P D E \/ A A0 A1 A2 A3 A4 A5 B F F1 F2 F3 G H L O R S T1)
\n (setq a0 (angle C M)) ;\u957f\u8f74\u7684\u65b9\u5411\u89d2
\n (setq a1 (angle p D)) ;\u76f4\u7ebf\u4e00\u7684\u65b9\u5411\u89d2
\n (setq a2 (angle p E)) ;\u76f4\u7ebf\u4e8c\u7684\u65b9\u5411\u89d2
\n (setq a3 (* (+ a1 a2) 0.5)) ;\u4e24\u76f4\u7ebf\u5185\u89d2\u5e73\u5206\u7ebf
\n (setq a4 (+ a3 (* pi 0.5))) ;\u4e24\u76f4\u7ebf\u5916\u89d2\u5e73\u5206\u7ebf
\n (setq G (inters P (polar P a3 1) C M nil)) ;\u5185\u89d2\u5e73\u5206\u7ebf\u4e0e\u957f\u8f74\u4ea4\u4e8eG
\n (setq H (inters P (polar p a4 1) C M nil)) ;\u5916\u89d2\u5e73\u5206\u7ebf\u4e0e\u957f\u8f74\u4ea4\u4e8eH
\n (if (and G H) ;\u5982\u679c\u4ea4\u70b9\u90fd\u5b58\u5728\uff08\u5426\u5219\u65e0\u89e3\u6216\u65e0\u7a77\u89e3\uff09
\n (progn
\n (setq O (Geo:MidPoint G H)) ;GH\u7684\u4e2d\u70b9\u4e3a\u5706\u5fc3\uff0cGH\u4e3a\u76f4\u5f84\u505a\u4f5c\u5706
\n (setq R (distance O G)) ;OG\u4e3a\u8fd9\u4e2a\u5706\u7684\u534a\u5f84
\n (setq L (distance O C))
\n (if (>= L R) ;\u5982\u679c\u53ef\u4ee5\u4f5c\u5207\u7ebf
\n (progn
\n (setq F (sqrt (* (+ L R) (- L R)))) ;\u5207\u7ebf\u957f\u5373\u4e3a\u7126\u8ddd
\n (setq F1 (polar C a0 (- F))) ;\u5de6\u7126\u70b9F1
\n (setq F2 (polar C a0 F)) ;\u53f3\u7126\u70b9F2
\n (setq F3 (polar P (+ a1 (- a1 (angle P F1))) (distance P F1)));F1\u5173\u4e8ePD\u7684\u5bf9\u79f0\u70b9F3
\n (setq T1 (inters F2 F3 P D nil)) ;F2F3\u4e0ePD\u7684\u4ea4\u70b9\u4e3a\u5207\u70b9
\n (setq a5 (* (+ (angle T1 F1) (angle T1 F2)) 0.5)) ;\u89d2F1T1F2\u7684\u5e73\u5206\u7ebf
\n (if (or (equal a5 a1 1e-6) (equal (abs (- a1 a5)) pi 1e-6)) ;\u5982\u679c\u5e73\u5206\u7ebf\u4e0ePD\u91cd\u5408
\n nil ;\u65e0\u89e3
\n (setq a (* 0.5 (+ (distance F1 T1) (distance F2 T1))) ;\u5426\u5219\u5f97\u5230\u692d\u5706\u7684\u957f\u8f74\u957f
\n b (sqrt (* (- a f) (+ a f))) ;\u7531\u7126\u8ddd\u548c\u957f\u8f74\u5f97\u5230\u77ed\u8f74
\n s (list C a b a0) ;\u56e0\u800c\u5f97\u89e3
\n )
\n )
\n )
\n )
\n )
\n )
\n)<\/p>\n

(defun c:MajorDirection_2Tangents ()
\n (initget 1)
\n (setq C (getpoint “n\u4e2d\u5fc3: “))
\n (initget 1)
\n (setq M (getpoint C “n\u4e3b\u8981\u65b9\u5411: “))
\n (initget 1)
\n (setq P (getpoint “n\u4ea4\u70b9: “))
\n (initget 1)
\n (setq D (getpoint P “n\u76f4\u7ebf1\uff1a”))
\n (initget 1)
\n (setq E (getpoint P “n\u76f4\u7ebf2\uff1a”))
\n (setq C (trans C 1 0))
\n (setq M (trans M 1 0))
\n (setq P (trans P 1 0))
\n (setq D (trans D 1 0))
\n (setq E (trans E 1 0))
\n (mapcar ‘Ent:make_Point (list C M P D E))
\n (Ent:make_line P D)
\n (Ent:make_line P E)
\n (Ent:make_line C M)
\n (setq S (ELL:MajorDirection_2Tangents C M P D E))
\n (and S (apply ‘Ent:Make_Ellipse S))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, the center, the directions of a pair of
\n;;; conjugate diameters, a tangent and a point on the curve being given
\n;;; \u5df2\u77e5\u692d\u5706\u7684\u5171\u8f6d\u8f74\u7684\u65b9\u5411\u548c\u692d\u5706\u7684\u4e0a\u7684\u4e00\u70b9\u4ee5\u53ca\u4e00\u6761\u5207\u7ebf\uff0c\u4f5c\u8fd9\u4e2a\u692d\u5706
\n;;;=====================================================================
\n(defun ELL:ConjugateDirections_Point_Tangent (C D E P P1 P2 \/)
\n (if (or (LINE:Colinearity C D E)
\n (LINE:Colinearity C P1 P2)
\n (equal P C 1e-8)
\n )
\n nil
\n (progn
\n (setq M (inters P1 P2 C D nil))
\n (setq N (inters P1 P2 C E nil))
\n (setq L1 (distance C P))
\n (if (and M N)
\n (if (setq F (inters C P M N nil))
\n (if (>= (setq L2 (distance C F)) L1)
\n (progn
\n (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))
\n (setq O (Geo:MidPoint M N))
\n (setq R (distance O M))
\n (setq a1 (angle F O))
\n (setq a2 (+ a1 (* pi 0.5)))
\n (setq J (polar F a1 L3))
\n (setq K (polar J a2 L1))
\n (setq S nil)
\n (foreach I (CIR:Inters_Circle_Line O R F K)
\n (setq H (inters I (polar I a2 1) M N nil))
\n (setq G (polar C a1 (distance H I)))
\n (setq S (cons (ELL:2ConjugateDiameters C G H) S))
\n )
\n )
\n )
\n (cond
\n ( (equal L1 (setq R (* 0.5 (distance M N))) 1e-8)
\n (List (ELL:2ConjugateDiameters C P (Geo:MidPoint M N)))
\n )
\n ( (< L1 R)
\n (setq O (Geo:MidPoint M N))
\n (setq L2 (sqrt (* (+ R L1) (- R L1))))
\n (setq a1 (angle O M))
\n (setq J (polar O a1 L2))
\n (setq K (polar O a1 (- L2)))
\n (setq S nil)
\n (foreach I (list J K)
\n (setq S (cons (ELL:2ConjugateDiameters C I P) S))
\n )
\n )
\n )
\n )
\n (progn
\n (and N (setq M N N D D E E N))
\n (if (setq F (inters C P P1 P2 nil))
\n (if (< L1 (setq L2 (distance C F)))
\n (progn
\n (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))
\n (setq L4 (\/ (* L1 (distance F M)) L3))
\n (setq E (polar C (angle C E) L4))
\n (list (ELL:2ConjugateDiameters C E M))
\n )
\n )
\n (list (ELL:2ConjugateDiameters C P M))
\n )
\n )
\n )
\n )
\n )
\n)<\/p>\n

(defun C:ConjugateDirections_Point_Tangent ()
\n (initget 1)
\n (setq C (getpoint “n\u4e2d\u5fc3: “))
\n (initget 1)
\n (setq D (getpoint C “n\u5171\u8f6d\u65b9\u54111: “))
\n (initget 1)
\n (setq E (getpoint C “n\u5171\u8f6d\u65b9\u54112: “))
\n (initget 1)
\n (setq P (getpoint “n\u692d\u5706\u4e0a\u4e00\u70b9: “))
\n (initget 1)
\n (setq M (getpoint “n\u76f4\u7ebf\u7aef\u70b91: “))
\n (initget 1)
\n (setq N (getpoint M “n\u76f4\u7ebf\u7aef\u70b92: “))
\n\u3000\u3000
\n (setq C (trans C 1 0))
\n (setq D (trans D 1 0))
\n (setq E (trans E 1 0))
\n (setq P (trans P 1 0))
\n (setq M (trans M 1 0))
\n (setq N (trans N 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list C D E P M N))
\n (Ent:make_line M N)
\n (Ent:make_line C E)
\n (Ent:make_line C D)
\n (setq S (ELL:ConjugateDirections_Point_Tangent C D E P M N))
\n (foreach x S (apply ‘Ent:Make_Ellipse x))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, the center, two tangents and a point on the
\n;;; curve being given
\n;;;=====================================================================
\n(defun ELL:Center_Point_2Tangents (C P I M N \/ A1 A2 A3 D E F G H L1 L2 L3 O R S)
\n (if (not (setq E (inters C P I N nil)))
\n (setq E N N M M E E (inters C P I N nil))
\n )
\n (setq L1 (distance C P))
\n (setq L2 (distance C E))
\n (if (> L2 L1)
\n (progn
\n (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))
\n (setq a1 (angle I M))
\n (setq a2 (angle I N))
\n (setq a3 (+ a2 (* pi 0.5)))
\n (setq O (inters C (polar C a1 1) I N nil))
\n (setq F (polar E a2 L3))
\n (setq G (polar F a3 L1))
\n (setq R (distance O I))
\n (foreach K (CIR:Inters_Circle_Line O R G E)
\n (setq H (inters K (polar K a3 1) I N nil))
\n (setq D (polar C a2 (distance K H)))
\n (setq s (cons (ELL:2ConjugateDiameters C H D) s))
\n )
\n )
\n )
\n)<\/p>\n

(defun c:Center_Point_2Tangents ()
\n (initget 1)
\n (setq C (getpoint “n\u4e2d\u5fc3: “))
\n (initget 1)
\n (setq P (getpoint C “n\u692d\u5706\u4e0a\u4e00\u70b9: “))
\n (initget 1)
\n (setq I (getpoint “n\u5207\u7ebf\u4ea4\u70b9: “))
\n (initget 1)
\n (setq M (getpoint I “n\u5207\u7ebf1: “))
\n (initget 1)
\n (setq N (getpoint I “n\u5207\u7ebf2: “))
\n\u3000\u3000
\n (setq C (trans C 1 0))
\n (setq P (trans P 1 0))
\n (setq I (trans I 1 0))
\n (setq M (trans M 1 0))
\n (setq N (trans N 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list C P I M N))
\n (Ent:make_line I M)
\n (Ent:make_line I N)
\n (Ent:make_line C P)
\n (setq S (ELL:Center_Point_2Tangents C P I M N))
\n (foreach x S (apply ‘Ent:Make_Ellipse x))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, the center, two points on curve and a tangent
\n;;; being given
\n;;;=====================================================================
\n(defun ELL:Center_2Points_Tangent (C A B P Q \/ d e)
\n (setq D (GEO:MidPoint A B))
\n (setq E (inters C (polar C (angle A B) 1) P Q nil))
\n (ELL:ConjugateDirections_Point_Tangent C D E A P Q)
\n)<\/p>\n

(defun c:vvv()
\n (initget 1)
\n (setq C (getpoint “n\u4e2d\u5fc3: “))
\n (initget 1)
\n (setq A (getpoint C “n\u70b91: “))
\n (initget 1)
\n (setq B (getpoint C “n\u70b92: “))
\n (initget 1)
\n (setq P (getpoint “n\u5207\u7ebf\u70b91: “))\u3000\u3000
\n (initget 1)
\n (setq Q (getpoint P “n\u5207\u7ebf\u70b92: “))\u3000\u3000
\n (setq C (trans C 1 0))
\n (setq A (trans A 1 0))
\n (setq B (trans B 1 0))
\n (setq P (trans P 1 0))
\n (setq Q (trans Q 1 0))
\n (mapcar ‘Ent:make_Point (list C A B P Q))
\n (Ent:make_line P Q)
\n (foreach x (ELL:Center_2Points_Tangent C A B P Q)
\n (apply ‘Ent:Make_Ellipse x)
\n )
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, the center, three tangents being given
\n;;;=====================================================================
\n(defun ELL:Center_3Tangents (C D E F \/ A B D1 D2 D3 G H I J K L1 L2 L3 P Q U W X Y)
\n (setq d1 (distance C D))
\n (setq d2 (distance C E))
\n (setq d3 (distance C F))
\n (setq l3 (distance D E))
\n (setq l2 (distance D F))
\n (setq l1 (distance E F))<\/p>\n

(if (and (TRI:IsTriangle l1 l2 l3)
\n (TRI:IsTriangle d1 d2 l3)
\n (TRI:IsTriangle d2 d3 l1)
\n (TRI:IsTriangle d3 d1 l2)
\n )
\n (progn
\n (setq X (inters (GEO:scale2 C D) (GEO:scale2 C F) D E nil))
\n (setq Y (GEO:Scale2 C X))
\n (setq G (inters Y (polar Y (angle C E) 1) E F nil))
\n (setq H (inters X (polar X (angle C F) 1) E F nil))
\n (setq I (inters X G Y H nil))
\n (setq J (inters I D E F nil))
\n (setq K (inters J (polar J (angle X G) 1) D E nil))
\n (setq A (angle C X))
\n (setq B (angle C D))
\n (setq P (inters K (polar K B 1) X Y nil))
\n (setq Q (inters K (polar K A 1) C D nil))
\n (setq D1 (distance C P))
\n (setq D2 (distance C X))
\n (setq L1 (distance C Q))
\n (setq L2 (distance C D))
\n (if (and (< D1 D2) (< L1 L2))
\n (progn
\n (setq U (polar C A (sqrt (* D1 D2))))
\n (setq W (polar C B (sqrt (* L1 L2))))
\n (ELL:2ConjugateDiameters C U W)
\n )
\n )
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;;highflybird 2012.5.29 \u521b\u4f5c\u4e8e\u6df1\u5733 2013.5.5 \u4fee\u6539\u4e8e\u6df1\u5733
\n;;;———————————————————————
\n;;;\u529f\u80fd\uff1a\u6839\u636e\u4e2d\u5fc3\u548c\u692d\u5706\u4e0a\u7684\u4e09\u70b9\u753b\u8fd9\u4e2a\u692d\u5706
\n;;;\u53c2\u6570\uff1a\u4e2d\u5fc3\u70b9\uff0c\u548c\u5176\u4ed6\u4e09\u70b9
\n;;;\u8fd4\u56de\uff1a\u4e2d\u5fc3\u70b9\uff0c\u534a\u957f\u8f74\u503c\u3001\u534a\u77ed\u8f74\u3001\u65cb\u8f6c\u89d2
\n;;;=====================================================================
\n(defun ELL:C3P (Cen p1 p2 p3 \/ a b c abc ac bb aX bY an I J PT1 PT2 PT3 SS)
\n (setq p1 (mapcar ‘- p1 cen))
\n (setq p2 (mapcar ‘- p2 cen))
\n (setq p3 (mapcar ‘- p3 cen))
\n (setq abc (Mat:3VLE (* (car p1) (car p1))
\n (* (car p1) (cadr p1))
\n (* (cadr p1) (cadr p1))
\n (* (car p2) (car p2))
\n (* (car p2) (cadr p2))
\n (* (cadr p2) (cadr p2))
\n (* (car p3) (car p3))
\n (* (car p3) (cadr p3))
\n (* (cadr p3) (cadr p3))
\n 1. 1. 1.
\n )
\n )
\n (if abc
\n (progn
\n (setq a (car abc))
\n (setq b (cadr abc))
\n (setq c (caddr abc))
\n (setq b (\/ b 2))
\n (setq bb (* b b))
\n (setq ac (* a c))
\n (setq I (+ a c))
\n (setq J (- a c))
\n (setq ss (sqrt (+ (* J J) (* 4 bb))))
\n (if (> I ss)
\n (progn
\n (setq aX (sqrt (\/ 2 (- I ss))))
\n (setq bY (sqrt (\/ 2 (+ I ss))))
\n (if (equal (\/ J I) 0 1e-16)
\n (setq an (\/ (atan b 0) 2))
\n (setq an (\/ (atan (\/ (+ b b) J)) 2))
\n )
\n (and (> a c) (setq an (+ an (\/ pi 2))))
\n (list cen aX bY an) ;\u8fd4\u56de\u4e2d\u5fc3\uff0c\u534a\u957f\u8f74\uff0c\u534a\u77ed\u8f74\uff0c\u65cb\u8f6c\u89d2\u5ea6
\n )
\n )
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;;highflybird 2012.5.29
\n;;;\u529f\u80fd\uff1a\u6839\u636e\u4e2d\u5fc3\u548c\u692d\u5706\u4e0a\u7684\u4e09\u70b9\u753b\u8fd9\u4e2a\u692d\u5706\uff08\u53e6\u4e00\u7b97\u6cd5\uff09
\n;;;\u53c2\u6570\uff1a\u4e2d\u5fc3\u70b9\uff0c\u548c\u5176\u4ed6\u4e09\u70b9
\n;;;\u8fd4\u56de\uff1a\u4e2d\u5fc3\u70b9\uff0c\u534a\u957f\u8f74\u503c\u3001\u534a\u77ed\u8f74\u3001\u65cb\u8f6c\u89d2
\n;;;=====================================================================
\n(defun ELL:C3P_1 (Cen p1 p2 p3 \/ A11 A12 A13 A21 A22 A23 A31 A32 A33
\n ANG A B PT1 PT2 PT3 UVW U V W)
\n (setq pt1 (mapcar ‘- p1 cen))
\n (setq pt2 (mapcar ‘- p2 cen))
\n (setq pt3 (mapcar ‘- p3 cen))
\n (setq a11 (* (car pt1) (car pt1)))
\n (setq a12 (* (car pt1) (cadr pt1)))
\n (setq a13 (* (cadr pt1) (cadr pt1)))
\n (setq a21 (* (car pt2) (car pt2)))
\n (setq a22 (* (car pt2) (cadr pt2)))
\n (setq a23 (* (cadr pt2) (cadr pt2)))
\n (setq a31 (* (car pt3) (car pt3)))
\n (setq a32 (* (car pt3) (cadr pt3)))
\n (setq a33 (* (cadr pt3) (cadr pt3)))
\n (setq uvw (MAT:3VLE a11 a12 a13 a21 a22 a23 a31 a32 a33 1. 1. 1.))
\n (setq u (car uvw))
\n (setq v (cadr uvw))
\n (setq w (caddr uvw))
\n (if uvw
\n (if (and (zerop v) (equal u w 1e-16)) ;\u8fd9\u662f\u4e2a\u5706
\n (list cen (sqrt (\/ 1 u)))
\n (progn
\n (if (zerop v)
\n (setq ang (\/ (atan 0 (- u w)) 2)
\n a (\/ (+ u w (\/ (- u w) (cos (* 2 ang)))) 2.0)
\n )
\n (progn
\n (if (equal u w 1e-16)
\n (setq ang (\/ (atan v 0) 2))
\n (setq ang (\/ (atan (\/ v (- u w))) 2))
\n )
\n (setq a (\/ (+ u w (\/ v (sin (* 2 ang)))) 2.0))
\n )
\n )
\n (setq b (+ u w (- a)))
\n (if (and (> a 0) (> b 0))
\n (progn
\n (setq a (sqrt (\/ 1 a)))
\n (setq b (sqrt (\/ 1 b)))
\n (if (> b a)
\n (list cen b a (+ ang (\/ pi 2)))
\n (list cen a b ang)
\n )
\n )
\n )
\n )
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;;highflybird 2012.5.29 \u521b\u4f5c\u4e8e\u6df1\u5733 2013.5.5 \u4fee\u6539\u4e8e\u6df1\u5733
\n;;;———————————————————————
\n;;;\u529f\u80fd\uff1a\u6839\u636e\u692d\u5706\u4e0a\u7684\u56db\u70b9\u753b\u6c34\u5e73(\u6216\u8005\u5782\u76f4)\u65b9\u5411\u692d\u5706
\n;;;\u53c2\u6570\uff1a\u56db\u4e2a\u7ed9\u5b9a\u7684\u4e8c\u4f4d\u6216\u8005\u4e09\u7ef4\u70b9
\n;;;\u8fd4\u56de\uff1a\u4e2d\u5fc3\u70b9\uff0c\u534a\u957f\u8f74\u503c\u3001\u534a\u77ed\u8f74\u3001\u65cb\u8f6c\u89d2
\n;;;=====================================================================
\n(defun ELL:4P (p0 p1 p2 p3 \/ A B C D K M N O X1 X2 X3 Y1 Y2 Y3 U1 U2 U3 W1 W2 W3)
\n (setq p1 (mapcar ‘- p1 p0)
\n p2 (mapcar ‘- p2 p0)
\n p3 (mapcar ‘- p3 p0)
\n x1 (car p1)
\n y1 (cadr p1)
\n x2 (car p2)
\n y2 (cadr p2)
\n x3 (car p3)
\n y3 (cadr p3)
\n U1 (* x1 x1)
\n W1 (* y1 y1)
\n U2 (* x2 x2)
\n W2 (* y2 y2)
\n U3 (* x3 x3)
\n W3 (* y3 y3)
\n A (MAT:Det3 W1 x1 y1 W2 x2 y2 W3 x3 y3)
\n B (MAT:Det3 U1 x1 y1 U2 x2 y2 U3 x3 y3)
\n C (MAT:Det3 U1 W1 y1 U2 W2 y2 U3 W3 y3)
\n D (MAT:Det3 U1 W1 x1 U2 W2 x2 U3 W3 x3)
\n B (- B)
\n D (- D)
\n )
\n (if (or (and (> A 0) (> B 0)) (and (< A 0) (< B 0)))
\n (progn
\n (setq K (+ (\/ (* C C) 4 A) (\/ (* D D) 4 B)))
\n (setq m (sqrt (\/ K A)))
\n (setq n (sqrt (\/ K B)))
\n (setq O (list (\/ C A -2) (\/ D B -2) 0))
\n (setq O (mapcar ‘+ O P0))
\n (if (\/= m 0.0 n 0.0)
\n (if (> n m)
\n (list O n m (\/ pi 2)) ;\u8fd4\u56de\u4e2d\u5fc3\uff0c\u534a\u957f\u8f74\uff0c\u534a\u77ed\u8f74\uff0c\u65cb\u8f6c\u89d2\u5ea690\u5ea6
\n (list O m n 0.0) ;\u8fd4\u56de\u4e2d\u5fc3\uff0c\u534a\u957f\u8f74\uff0c\u534a\u77ed\u8f74\uff0c\u65cb\u8f6c\u89d2\u5ea60\u5ea6
\n )
\n )
\n )
\n )
\n)<\/p>\n

(defun C:test (\/ pt1 pt2 pt3 pt4 mod res)
\n (initget “C P”)
\n (setq mod (getkword “nDraw an ellipse by [C3P(C)\/4P(P)] <C>:”))
\n (and (\/= mod “P”) (setq mod nil))<\/p>\n

(setq pt1 (getpoint “nEnter 1st point: “))
\n (setq pt2 (getpoint “nEnter 2nd point: “))
\n (setq pt3 (getpoint “nEnter 3rd point: “))
\n (if mod
\n (setq pt4 (getpoint “nEnter 4th point: “))
\n (setq pt4 (getpoint “nEnter the center: “))
\n )
\n (if (and pt4 pt1 pt2 pt3)
\n (progn
\n (setq pt1 (trans pt1 1 0))
\n (setq pt2 (trans pt2 1 0))
\n (setq pt3 (trans pt3 1 0))
\n (setq pt4 (trans pt4 1 0))<\/p>\n

(mapcar ‘ENT:Make_Point (list pt4 pt1 pt2 pt3))
\n (if mod
\n (setq res (ELL:4P pt4 pt1 pt2 pt3))
\n (progn
\n ;(MISC:test 10001 ‘((ELL:C3p pt4 pt1 pt2 pt3) (ELL:C3P_1 pt4 pt1 pt2 pt3)))
\n (setq res (ELL:C3P pt4 pt1 pt2 pt3))
\n )
\n )
\n (if res
\n (if (caddr res)
\n (apply ‘ENT:Make_Ellipse res)
\n (apply ‘ENT:Make_Circle res)
\n )
\n (princ “nInvalid input or can’t construct the ellipse!”)
\n )
\n )
\n )
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, the center, 3 points on the curve being given
\n;;;=====================================================================
\n(defun ELL:Center_3Points (C D E F \/ G H I J K M P Q R)
\n (setq G (GEO:MidPoint E F))
\n (setq H (GEO:MidPoint D F))
\n (setq I (GEO:MidPoint D E))
\n (if (setq J (inters C G D F nil))
\n (setq K (inters C I E J nil)
\n M (inters H K E F nil)
\n )
\n (setq K (inters C G D E nil)
\n J (inters C H F K nil)
\n M (inters I J E F nil)
\n )
\n )
\n (and (null M )(setq M (polar D (angle E F) (distance E F))))
\n (setq P (inters C I D M nil))
\n (setq Q (inters C H D M nil))
\n (if (and P Q (setq R (inters E P F Q nil)))
\n (ELL:Center_3Tangents C P Q R)
\n )
\n)
\n(defun c:aaa ()
\n (initget 1)
\n (setq C (getpoint “n\u4e2d\u5fc3: “))
\n (initget 1)
\n (setq D (getpoint “n\u70b91: “))
\n (initget 1)
\n (setq E (getpoint “n\u70b92: “))
\n (initget 1)
\n (setq F (getpoint “n\u70b93: “))\u3000\u3000<\/p>\n

(setq C (trans C 1 0))
\n (setq D (trans D 1 0))
\n (setq E (trans E 1 0))
\n (setq F (trans F 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list C D E F))
\n (Ent:make_line D E)
\n (Ent:make_line D F)
\n (Ent:make_line E F)
\n ;(setq S (ELL:Center_3Tangents C D E F))
\n ;(misc:test 100001 ‘((ELL:Center_3Points C D E F) (ELL:C3P C D E F)))
\n ;(setq S (ELL:Center_3Points C D E F))
\n (setq s (ELL:C3P C D E F))
\n (and S (apply ‘Ent:Make_Ellipse S))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, the foci and a point on the curve being given.
\n;;;=====================================================================
\n(defun ELL:Foci_Point (E F P \/ o a b c)
\n (setq O (GEO:MidPoint E F))
\n (setq c (distance O F))
\n (setq a (* 0.5 (+ (distance E P) (distance F P))))
\n (setq b (sqrt (* (+ a c) (- a c))))
\n (list O a b (angle E F))
\n)
\n(defun c:zzz ()
\n (initget 1)
\n (setq E (getpoint “n\u7126\u70b91: “))
\n (initget 1)
\n (setq F (getpoint E “n\u7126\u70b92: “))
\n (initget 1)
\n (setq P (getpoint “n\u4e00\u70b9: “))<\/p>\n

(setq E (trans E 1 0))
\n (setq F (trans F 1 0))
\n (setq P (trans P 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list E F P))
\n (setq s (ELL:Foci_Point E F P))
\n (and S (apply ‘Ent:Make_Ellipse S))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse,the foci and a tangent to the curve being given
\n;;;=====================================================================
\n(defun ELL:Foci_Tangent (E F P Q \/ G H I)
\n (setq I (inters P Q E F nil))
\n (if (and I (equal (angle E I) (angle I F) 1e-8))
\n nil
\n (progn
\n (setq G (GEO:Mirror2D E P (angle P Q)))
\n (setq H (inters P Q F G nil))
\n (ELL:Foci_Point E F H)
\n )
\n )
\n)<\/p>\n

(defun c:Foci_Tangent()
\n (initget 1)
\n (setq E (getpoint “n\u7126\u70b91: “))
\n (initget 1)
\n (setq F (getpoint E “n\u7126\u70b92: “))
\n (initget 1)
\n (setq P (getpoint “n\u4e00\u70b9: “))
\n (initget 1)
\n (setq Q (getpoint P “n\u53e6\u4e00\u70b9: “))<\/p>\n

(setq E (trans E 1 0))
\n (setq F (trans F 1 0))
\n (setq P (trans P 1 0))
\n (setq Q (trans Q 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list E F P Q))
\n ;(apply ‘Ent:Make_Ellipse (ELL:Foci_Point E F P))
\n (setq S (ELL:Foci_Tangent E F P Q))
\n (and S (apply ‘Ent:Make_Ellipse))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, a focus, a tangent with its point of contact
\n;;; and second point on the curve being given
\n;;;=====================================================================
\n(defun ELL:Focus_Point_Tangent (F P R S \/ G H M J E)
\n (if (LINE:IsSameSide F P R S)
\n (progn
\n (setq G (GEO:Mirror2D F R (angle R S)))
\n (setq H (polar G (angle G R) (distance F P)))
\n (setq M (GEO:MidPoint H P))
\n (setq J (polar M (+ (angle H P) (* pi 0.5)) 1))
\n (setq E (inters M J R G nil))
\n (if (LINE:IsSameSide E F R S)
\n (ELL:Foci_Point E F P)
\n )
\n )
\n )
\n)<\/p>\n

(defun c:Focus_Point_Tangent ()
\n (initget 1)
\n (setq F (getpoint “n\u7126\u70b9: “))
\n (initget 1)
\n (setq A (getpoint “n\u70b9: “))
\n (initget 1)
\n (setq P (getpoint “n\u5207\u70b9: “))
\n (initget 1)
\n (setq Q (getpoint P “n\u53e6\u4e00\u70b9: “))<\/p>\n

(setq F (trans F 1 0))
\n (setq A (trans A 1 0))
\n (setq P (trans P 1 0))
\n (setq Q (trans Q 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list F A P Q))
\n (Ent:Make_line P Q)
\n (setq S (ELL:Focus_Point_Tangent F A P Q))
\n (and S (apply ‘Ent:Make_Ellipse s))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, a focus, a tangent and two points on the curve
\n;;; being given
\n;;;=====================================================================
\n(defun ELL:Focus_Tangent_2Points (F M N P Q \/ d1 d2 d3 d4 d5 E O S X)
\n (if (and (LINE:IsSameSide F P M N) (LINE:IsSameSide F Q M N))
\n (progn
\n (setq E (GEO:Mirror2D F M (angle M N)))
\n (setq d1 (distance F P))
\n (setq d2 (distance F Q))
\n (if (equal d1 d2 1e-8)
\n (setq X (CIR:PPC P Q E d1))
\n (if (> d1 d2)
\n (setq X (CIR:PCC P Q (- d1 d2) E d1))
\n (setq X (CIR:PCC Q P (- d2 d1) E d2))
\n )
\n )
\n (foreach v X
\n (setq O (car v))
\n (setq d3 (distance O E))
\n (setq d4 (+ d1 (distance O P)))
\n (setq d5 (+ d2 (distance O Q)))
\n (if (and (equal d3 d4 1e-8) (equal d3 d5 1e-8))
\n (setq s (cons (ELL:Foci_Point O F P) s))
\n )
\n )
\n (reverse S)
\n )
\n )
\n)<\/p>\n

(defun c:Focus_Tangent_2Points ()
\n (initget 1)
\n (setq F (getpoint “n\u7126\u70b9: “))
\n (initget 1)
\n (setq M (getpoint “n\u5207\u7ebf\u70b91: “))
\n (initget 1)
\n (setq N (getpoint M “n\u5207\u7ebf\u70b92: “))
\n (initget 1)
\n (setq P (getpoint “n\u70b91: “))
\n (initget 1)
\n (setq Q (getpoint “n\u70b92: “))<\/p>\n

(setq F (trans F 1 0))
\n (setq M (trans M 1 0))
\n (setq N (trans N 1 0))
\n (setq P (trans P 1 0))
\n (setq Q (trans Q 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list F M N P Q))
\n (Ent:Make_line M N)
\n (setq S (ELL:Focus_Tangent_2Points F M N P Q))
\n (foreach el S
\n (apply ‘Ent:Make_Ellipse el)
\n )
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, a focus, a point on the curve and two tangents
\n;;; being given
\n;;;=====================================================================
\n(defun ELL:Focus_Point_2Tangents (F P L1 L2 L3 L4 \/ D1 D2 D3 E G H R s)
\n (setq G (GEO:Mirror2D F L1 (angle L1 L2)))
\n (setq H (GEO:Mirror2D F L3 (angle L3 L4)))
\n (setq S nil)
\n (setq R (distance P F))
\n (foreach n (CIR:PPC G H P R)
\n (setq E (car n))
\n (setq d1 (distance E G))
\n (setq d2 (distance E H))
\n (setq d3 (+ R (distance E P)))
\n (if (and (equal d1 d2 1e-6) (equal d2 d3 1e-6))
\n (setq s (cons (ELL:Foci_Point E F P) s))
\n )
\n )
\n S
\n)<\/p>\n

(defun c:Focus_Point_2Tangents ()
\n (initget 1)
\n (setq F (getpoint “n\u7126\u70b9: “))
\n (initget 1)
\n (setq P (getpoint “n\u70b9: “))<\/p>\n

(initget 1)
\n (setq J (getpoint “n\u5207\u7ebf\u70b91: “))
\n (initget 1)
\n (setq K (getpoint J “n\u5207\u7ebf\u70b92: “))<\/p>\n

(initget 1)
\n (setq M (getpoint “n\u5207\u7ebf\u70b91: “))
\n (initget 1)
\n (setq N (getpoint M “n\u5207\u7ebf\u70b92: “))<\/p>\n

(setq F (trans F 1 0))
\n (setq P (trans P 1 0))
\n (setq J (trans J 1 0))
\n (setq K (trans K 1 0))
\n (setq M (trans M 1 0))
\n (setq N (trans N 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list F P J K M N))
\n (Ent:Make_line M N)
\n (Ent:Make_line J K)
\n (setq S (ELL:Focus_Point_2Tangents F P J K M N))
\n (foreach el S
\n (apply ‘Ent:Make_Ellipse el)
\n )
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, a focus and three tangents being given
\n;;;=====================================================================
\n(defun ELL:Focus_3Tangents (F L1 L2 L3 L4 L5 L6 \/ E G H I)
\n (setq G (GEO:Mirror2D F L1 (angle L1 L2)))
\n (setq H (GEO:Mirror2D F L3 (angle L3 L4)))
\n (setq I (GEO:Mirror2D F L5 (angle L5 L6)))
\n (if (setq E (car (TRI:CircumCenter G H I)))
\n (if (and (LINE:IsSameSide E F L1 L2)
\n (LINE:IsSameSide E F L3 L4)
\n (LINE:IsSameSide E F L5 L6)
\n )
\n (ELL:Foci_Point E F (inters E G L1 L2 nil))
\n )
\n )
\n)<\/p>\n

(defun c:vvv ()
\n (initget 1)
\n (setq F (getpoint “n\u7126\u70b9: “))
\n (initget 1)
\n (setq P (getpoint “n\u5207\u7ebf\u70b91: “))
\n (initget 1)
\n (setq Q (getpoint P “n\u5207\u7ebf\u70b92: “))
\n (initget 1)
\n (setq J (getpoint “n\u5207\u7ebf\u70b91: “))
\n (initget 1)
\n (setq K (getpoint J “n\u5207\u7ebf\u70b92: “))
\n (initget 1)
\n (setq M (getpoint “n\u5207\u7ebf\u70b91: “))
\n (initget 1)
\n (setq N (getpoint M “n\u5207\u7ebf\u70b92: “))<\/p>\n

(setq F (trans F 1 0))
\n (setq P (trans P 1 0))
\n (setq Q (trans Q 1 0))
\n (setq J (trans J 1 0))
\n (setq K (trans K 1 0))
\n (setq M (trans M 1 0))
\n (setq N (trans N 1 0))<\/p>\n

(Ent:make_Point F)
\n (Ent:Make_line P Q)
\n (Ent:Make_line M N)
\n (Ent:Make_line J K)
\n (setq S (ELL:Focus_3Tangents F P Q J K M N))
\n (and S (apply ‘Ent:Make_Ellipse s))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, a focus and three points being given
\n;;;=====================================================================
\n(defun ELL:Focus_3Points (F I J K \/ a1 a2 a3 b1 b2 b3 p1 p2 p3 M N Pt)
\n (setq a1 (angle F I))
\n (setq A2 (angle F J))
\n (setq A3 (angle F K))
\n (setq b1 (* 0.5 (+ a1 a2)))
\n (setq b2 (* 0.5 (+ a2 a3)))
\n (setq b3 (* 0.5 (+ a3 a1)))
\n (setq p1 (polar F b1 pi))
\n (setq p2 (polar F b2 pi))
\n (setq P3 (polar F b3 pi))
\n (setq M (inters I P3 F P1 nil))
\n (setq N (inters K P3 F P2 nil))
\n (setq Pt (inters M N I K nil))
\n (and (null pt) (setq Pt (polar J (angle I K) Pi)))
\n (setq M (inters Pt J F P1 nil))
\n (setq N (inters Pt J F P2 nil))
\n (ELL:Focus_3Tangents F I M Pt J N K)
\n)<\/p>\n

(defun c:Focus_3Points ()
\n (initget 1)
\n (setq F (getpoint “n\u7126\u70b9: “))
\n (initget 1)
\n (setq I (getpoint “n\u70b91: “))
\n (initget 1)
\n (setq J (getpoint “n\u70b92: “))
\n (initget 1)
\n (setq K (getpoint “n\u70b93: “))<\/p>\n

(setq F (trans F 1 0))
\n (setq I (trans I 1 0))
\n (setq J (trans J 1 0))
\n (setq K (trans K 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list F I J K))
\n (setq S (ELL:Focus_3Points F I J K))
\n (and S (apply ‘Ent:Make_Ellipse s))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, two tangents with their points of contact and
\n;;; a third point being given
\n;;;=====================================================================
\n(defun ELL:2Tangents_Point (V Q R P \/ s u w x y m n c)
\n (setq S (inters Q P V R nil))
\n (setq U (inters V Q R P nil))
\n (cond
\n ( (and S U)
\n (setq W (inters U S Q R nil))
\n )
\n ( U
\n (setq W (polar U (angle V R) 1))
\n (setq W (inters U W Q R nil))
\n )
\n ( S
\n (setq W (polar S (angle V Q) 1))
\n (setq W (inters S W Q R nil))
\n )
\n (t
\n (setq W (polar P (angle Q R) 1))
\n )
\n )
\n (setq X (inters P W V R nil))
\n (setq Y (inters P W V Q nil))
\n (setq M (Geo:Midpoint Q R))
\n (setq N (Geo:MidPoint P R))
\n (setq C (inters V M X N nil))
\n (ELL:Center_3Tangents C V X Y)
\n)<\/p>\n

(defun c:vvv ()
\n (initget 1)
\n (setq V (getpoint “n\u4ea4\u70b9: “))
\n (initget 1)
\n (setq Q (getpoint V “n\u5207\u70b91: “))
\n (initget 1)
\n (setq R (getpoint V “n\u5207\u70b92: “))
\n (initget 1)
\n (setq P (getpoint “n\u70b9: “))<\/p>\n

(setq V (trans V 1 0))
\n (setq Q (trans Q 1 0))
\n (setq R (trans R 1 0))
\n (setq P (trans P 1 0))<\/p>\n

(mapcar ‘Ent:make_Point (list V Q R P))
\n (setq S (ELL:2Tangents_Point V Q R P))
\n (and S (apply ‘Ent:Make_Ellipse s))
\n (princ)
\n)<\/p>\n

(defun c:mean (\/ p0 p1 p2 an dd)
\n (initget 1)
\n (setq p0 (getpoint “n\u539f\u70b9:”))
\n (initget 1)
\n (setq p1 (getpoint “n\u7b2c\u4e00\u70b9:”))
\n (initget 1)
\n (setq p2 (getpoint “n\u7b2c\u4e8c\u70b9:”))
\n (setq an (angle p1 p2))
\n (setq dd (sqrt (* (distance p0 p1) (distance p0 p2))))
\n (ent:make_point (polar p0 an dd))
\n (ent:make_point (polar p0 an (- dd)))
\n (princ)
\n)<\/p>\n

(defun GEO:Mean(p A B)
\n (polar P (angle p A) (sqrt (* (distance p A) (distance p B))))
\n)<\/p>\n

;;;=====================================================================
\n;;; Function: Two pairs of conjugate points A,B and P,Q (collineation),
\n;;; being given,to find the center and foci of involution.
\n;;;=====================================================================
\n(defun GEO:Cen_Foci (A B P Q \/ M L an x x1 x2 cen len)
\n (setq M (GEO:Midpoint A B))
\n (setq L (distance M A))
\n (setq an (angle A B))
\n (setq x1 (distance M P))
\n (setq x2 (distance M Q))<\/p>\n

(if (not (equal (angle P M) an 1e-8)) (setq x1 (- x1)))
\n (if (not (equal (angle Q M) an 1e-8)) (setq x2 (- x2)))
\n (if (equal (setq x (+ x1 x2)) 0 1e-14)
\n (progn
\n (setq cen (polar M an 1e600))
\n (list cen M (polar M an 2e600))
\n )
\n (progn
\n (setq cen (polar M an (- (\/ (+ (* l l) (* x1 x2)) x))))
\n (setq len (sqrt (* (distance cen A) (distance cen B))))
\n (list cen (polar cen an len) (polar cen an (- len)))
\n )
\n )
\n)<\/p>\n

(defun c:fff ()
\n (initget 1)
\n (setq A (getpoint “n\u8f93\u5165\u7b2c\u4e00\u70b9:”))
\n (initget 1)
\n (setq B (getpoint “n\u8f93\u5165\u7b2c\u4e8c\u70b9:”))
\n (initget 1)
\n (setq P (getpoint “n\u8f93\u5165\u7b2c\u4e09\u70b9:”))
\n (initget 1)
\n (setq Q (getpoint “n\u8f93\u5165\u7b2c\u56db\u70b9:”))
\n (mapcar ‘ent:make_point (geo:cen_foci a b p q))
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, Construct an ellipse, two tangents and three
\n;;; points being given
\n;;;=====================================================================
\n(defun ELL:2Tangents_3Points (T1 T2 A B C \/ p1 p2 q1 q2 p q pts x1 x2 res s)
\n (setq p1 (car t1))
\n (setq p2 (cadr t1))
\n (setq q1 (car t2))
\n (setq q2 (cadr t2))
\n (foreach i (list B C)
\n (setq P (inters A i P1 P2 nil))
\n (setq q (inters A i Q1 Q2 nil))
\n (setq pts (cons (cdr (GEO:Cen_Foci A i p q)) pts))
\n )<\/p>\n

(foreach p (car pts)
\n (foreach q (cadr pts)
\n (setq x1 (inters p q p1 p2 nil))
\n (setq x2 (inters p q q1 q2 nil))
\n (if (and x1 x2)
\n (if (setq s (ELL:5PEllipse x1 x2 A B C))
\n (setq res (cons s res))
\n )
\n )
\n )
\n )
\n res
\n)<\/p>\n

;;;=====================================================================
\n;;; Construct an ellipse, Construct an ellipse, two tangents and three
\n;;; points being given
\n;;;=====================================================================
\n(defun ELL:3Tangents_2Points (T1 T2 T3 A B \/ p1 p2 q1 q2 r1 r2 p q r M N L U V W X Y res s)
\n (setq p1 (car t1))
\n (setq p2 (cadr t1))
\n (setq q1 (car t2))
\n (setq q2 (cadr t2))
\n (setq R1 (car t3))
\n (setq R2 (cadr t3))
\n (setq P (inters q1 q2 r1 r2 nil))
\n (setq Q (inters r1 r2 p1 p2 nil))
\n (setq R (inters p1 p2 q1 q2 nil))<\/p>\n

(setq M (inters A B R1 R2 nil))
\n (setq N (inters A B P1 P2 nil))
\n (setq L (inters A B Q1 Q2 nil))<\/p>\n

(foreach D (cdr (GEO:Cen_Foci A B M L))
\n (foreach E (cdr (Geo:Cen_FOci A B M N))
\n (setq V (Geo:Mean M D E))
\n (setq W (inters R V R1 R2 nil))
\n (setq X (inters W D Q1 Q2 nil))
\n (setq Y (inters W E P1 P2 nil))
\n (if (and W X Y)
\n ;;(if (setq S (ELL:2Tangents_Point Q W X A))
\n (if (setq S (ELL:5PEllipse A B W X Y))
\n (setq Res (cons S Res))
\n )
\n )
\n )
\n )
\n (reverse Res)
\n)<\/p>\n

(defun c:tt1()
\n (initget 1)
\n (setq en1 (car (entsel “n\u9009\u62e9\u7b2c\u4e00\u6761\u7ebf:”)))
\n (initget 1)
\n (setq en2 (car (entsel “n\u9009\u62e9\u7b2c\u4e8c\u6761\u7ebf:”)))
\n (initget 1)
\n (setq A (getpoint “n\u8f93\u5165\u7b2c\u4e00\u70b9:”))
\n (initget 1)
\n (setq B (getpoint “n\u8f93\u5165\u7b2c\u4e8c\u70b9:”))
\n (initget 1)
\n (setq C (getpoint “n\u8f93\u5165\u7b2c\u4e09\u70b9:”))
\n (if (and en1 en2 A B C)
\n (progn
\n (setq dxf1 (entget en1))
\n (setq dxf2 (entget en2))
\n (setq t1 (list (cdr (assoc 10 dxf1)) (cdr (assoc 11 dxf1))))
\n (setq t2 (list (cdr (assoc 10 dxf2)) (cdr (assoc 11 dxf2))))
\n (mapcar ‘ENT:MAKE_POINT (list A B C))
\n (foreach s (ELL:2Tangents_3Points t1 t2 A B C)
\n (and s (apply ‘ENT:MAKE_ELLIPSE s))
\n )
\n )
\n )
\n)<\/p>\n

(defun c:tt2()
\n (setq en1 (car (entsel “n\u9009\u62e9\u7b2c\u4e00\u6761\u7ebf:”)))
\n (setq en2 (car (entsel “n\u9009\u62e9\u7b2c\u4e8c\u6761\u7ebf:”)))
\n (setq en3 (car (entsel “n\u9009\u62e9\u7b2c\u4e09\u6761\u7ebf:”)))
\n (initget 1)
\n (setq A (getpoint “n\u8f93\u5165\u7b2c\u4e00\u70b9:”))
\n (initget 1)
\n (setq B (getpoint “n\u8f93\u5165\u7b2c\u4e8c\u70b9:”))
\n (if (and en1 en2 en3 A B)
\n (progn
\n (setq dxf1 (entget en1))
\n (setq dxf2 (entget en2))
\n (setq dxf3 (entget en3))
\n (setq t1 (list (cdr (assoc 10 dxf1)) (cdr (assoc 11 dxf1))))
\n (setq t2 (list (cdr (assoc 10 dxf2)) (cdr (assoc 11 dxf2))))
\n (setq t3 (list (cdr (assoc 10 dxf3)) (cdr (assoc 11 dxf3))))
\n (mapcar ‘ENT:MAKE_POINT (list A B))
\n (foreach s (ELL:3Tangents_2Points t1 t2 t3 A B)
\n (and s (apply ‘ENT:MAKE_ELLIPSE s))
\n )
\n )
\n )
\n)<\/p>\n

;;;==========================
\n;;;\u7a0b\u5e8f\u4e3b\u6bb5\uff0c\u53ef\u4ee5\u5355\u72ec\u6210\u4e3a\u51fd\u6570
\n;;;==========================
\n(defun Graham-scan (ptlist \/ hullpt maxXpt sortPt P Q)
\n (if (< (length ptlist) 4) ;3\u70b9\u4ee5\u4e0b
\n ptlist ;\u662f\u672c\u96c6\u5408
\n (progn
\n (setq maxXpt (assoc (apply ‘max (mapcar ‘car ptlist)) ptlist)) ;\u6700\u53f3\u8fb9\u7684\u70b9
\n (setq sortPt (sort-by-angle-distance ptlist maxXpt)) ;\u5206\u7c7b\u70b9\u96c6
\n (setq hullPt (list (cadr sortPt) maxXpt)) ;\u5f00\u59cb\u7684\u4e24\u70b9
\n (foreach n (cddr sortPt) ;\u4ece\u7b2c3\u70b9\u5f00\u59cb
\n (setq hullPt (cons n HullPt)) ;\u628aPi\u52a0\u5165\u5230\u51f8\u96c6
\n (setq P (cadr hullPt)) ;Pi-1
\n (setq Q (caddr hullPt)) ;Pi-2
\n (while (and q (> (det3P n P Q) -1e-6)) ;\u5982\u679c\u5de6\u8f6c
\n (setq hullPt (cons n (cddr hullPt))) ;\u5220\u9664Pi-1\u70b9
\n (setq P (cadr hullPt)) ;\u5f97\u5230\u65b0\u7684Pi-1\u70b9
\n (setq Q (caddr hullPt)) ;\u5f97\u5230\u65b0\u7684Pi-2\u70b9
\n )
\n )
\n (reverse hullpt) ;\u8fd4\u56de\u51f8\u96c6
\n )
\n )
\n)<\/p>\n

;;;\u4ee5\u6700\u4e0b\u9762\u7684\u70b9\u4e3a\u57fa\u70b9\uff0c\u6309\u7167\u89d2\u5ea6\u548c\u8ddd\u79bb\u5206\u7c7b\u70b9\u96c6
\n(defun sort-by-angle-distance (lst p \/)
\n (vl-sort
\n lst
\n (function
\n (lambda (e1 e2 \/ a1 a2)
\n (if (equal (setq a1 (angle p e1)) (setq a2 (angle p e2)) 1e-8)
\n (< (distance p e1) (distance p e2))
\n (< a1 a2)
\n )
\n )
\n )
\n )
\n)<\/p>\n

;;\u5b9a\u4e49\u4e09\u70b9\u7684\u884c\u5217\u5f0f,\u5373\u4e09\u70b9\u4e4b\u500d\u9762\u79ef
\n(defun det3P (p1 p2 p3 \/)
\n (- (* (- (car p2) (car p3)) (- (cadr p2) (cadr p1)))
\n (* (- (car p2) (car p1)) (- (cadr p2) (cadr p3)))
\n )
\n)
\n;;;=====================================================================
\n;;;\u529f\u80fd: \u8fc7\u4e94\u70b9\u753b\u4e00\u4e2a\u692d\u5706
\n;;;\u53c2\u6570: \u6ee1\u8db3\u5df2\u77e5\u6761\u4ef6\u7684\u4e94\u70b9
\n;;;\u8fd4\u56de: \u4e00\u4e2a\u692d\u5706\u5b9e\u4f53
\n;;;=====================================================================
\n(defun ELL:5PEllipse (p1 p2 p3 p4 p5 \/ p12 p23 p34 p45 t2 t3 t4 t23 t34 t42 m23 m34 m42 cen lst)
\n (setq lst (Graham-scan (list p1 p2 p3 p4 p5)))
\n (if (= (length lst) 5)
\n (progn
\n (setq p1 (car lst))
\n (setq p4 (cadr lst))
\n (setq p2 (caddr lst))
\n (setq p5 (cadddr lst))
\n (setq p3 (last lst))<\/p>\n

(setq p12 (inters p5 p1 p2 p3 nil))
\n (setq p23 (inters p1 p2 p3 p4 nil))
\n (setq p34 (inters p2 p3 p4 p5 nil))
\n (setq p45 (inters p3 p4 p5 p1 nil))<\/p>\n

(setq t2 (inters p12 p23 p4 p5 nil))
\n (setq t3 (inters p23 p34 p5 p1 nil))
\n (setq t4 (inters p34 p45 p1 p2 nil))<\/p>\n

(if (setq t23 (inters t2 p2 t3 p3 nil))
\n (if (setq t34 (inters t3 p3 t4 p4 nil))
\n (setq m23 (GEO:Midpoint p2 p3)
\n m34 (GEO:Midpoint p3 p4)
\n cen (inters t23 m23 t34 m34 nil)
\n )
\n (setq t42 (inters t4 p4 t2 p2 nil)
\n m42 (GEO:Midpoint p4 p2)
\n m23 (GEO:Midpoint p2 p3)
\n cen (inters t23 m23 t42 m42 nil)
\n )
\n )
\n (setq t42 (inters t4 p4 t2 p2 nil)
\n t34 (inters t3 p3 t4 p4 nil)
\n m34 (GEO:Midpoint p3 p4)
\n m42 (GEO:Midpoint p4 p2)
\n cen (inters t42 m42 t34 m34 nil)
\n )
\n )
\n (ELL:C3P cen p2 p3 p4)
\n )
\n )
\n)<\/p>\n

(defun c:test5 (\/ p1 p2 p3 p4 p5 ret)
\n (initget 1)
\n (setq p1 (getpoint “n\u8f93\u5165\u7b2c\u4e00\u70b9:”))
\n (initget 1)
\n (setq p2 (getpoint “n\u8f93\u5165\u7b2c\u4e8c\u70b9:”))
\n (initget 1)
\n (setq p3 (getpoint “n\u8f93\u5165\u7b2c\u4e09\u70b9:”))
\n (initget 1)
\n (setq p4 (getpoint “n\u8f93\u5165\u7b2c\u56db\u70b9:”))
\n (initget 1)
\n (setq p5 (getpoint “n\u8f93\u5165\u7b2c\u4e94\u70b9:”))
\n (setq ret (ELL:5PEllipse p1 p2 p3 p4 p5))
\n (and ret (apply ‘Ent:Make_Ellipse ret))
\n (Ent:Make_Poly (list p1 p2 p3 p4 p5))
\n (princ)
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: \u753bSteiner\u692d\u5706(\u4e09\u89d2\u5f62\u5185\u5177\u6709\u6700\u5927\u9762\u79ef\u7684\u5185\u5207\u692d\u5706)
\n;;; \u8f93\u5165: \u5e73\u9762\u7684\u4e09\u70b9
\n;;; \u8f93\u51fa: \u5e73\u9762\u7684\u692d\u5706\u7684\u57fa\u672c\u8981\u7d20\u8868
\n;;; \u53c2\u8003:
\n;;; http:\/\/bbs.mjtd.com\/thread-96417-1-1.html
\n;;; http:\/\/www.theswamp.org\/index.php?topic=42698.msg480873#msg480873
\n;;; http:\/\/en.wikipedia.org\/wiki\/Steiner_inellipse#cite_note-Scimemi-6
\n;;; \u65e5\u671f: 2012-09-11
\n;;;=====================================================================
\n(defun ELL:SteinerEllipse (pt1 pt2 pt3 \/ a b D E F G H M N O P R w)
\n (setq w (angle pt2 pt3))
\n (setq G (GEO:CENTROID (list pt1 pt2 pt3)))
\n (setq H (polar pt2 (+ w (\/ pi 3)) (distance pt2 pt3)))
\n (setq O (GEO:CENTROID (list H pt2 pt3)))
\n (setq N (GEO:MIDPOINT pt2 pt3))
\n (setq R (distance O N))
\n (setq M (GEO:MIDPOINT O G))
\n (setq P (polar M (+ (angle O G) (\/ pi 2)) (distance O G)))
\n (if (setq P (inters pt2 pt3 M P nil))
\n (progn
\n (setq d (distance P O))
\n (setq E (polar P w d))
\n (setq F (polar P w (- d)))
\n (setq a (* (distance G E) (\/ R (distance O E))))
\n (setq b (* (distance G F) (\/ R (distance O F))))
\n (list G a b (angle G E))
\n )
\n (progn
\n (setq a R)
\n (setq b (distance G N))
\n (list G a b w)
\n )
\n )
\n)<\/p>\n

;;;=====================================================================
\n;;; \u529f\u80fd: Steiner\u692d\u5706(\u4e09\u89d2\u5f62\u5185\u5177\u6709\u6700\u5927\u9762\u79ef\u7684\u5185\u5207\u692d\u5706)\u7684\u6d4b\u8bd5\u6837\u4f8b
\n;;; \u8f93\u5165: \u65e0\u3002
\n;;; \u8f93\u51fa: \u65e0\u3002
\n;;; \u65e5\u671f: 2012-09-11
\n;;;=====================================================================
\n(defun C:Steiner (\/ pt1 pt2 pt3 res ent obj)
\n (initget 9)
\n (setq pt1 (getpoint “n1st point:”))
\n (initget 9)
\n (setq pt2 (getpoint pt1 “n2nd point:”))
\n (initget 9)
\n (setq pt3 (getpoint pt2 “n3rd point:”))
\n (setq pt1 (trans pt1 1 0))
\n (setq pt2 (trans pt2 1 0))
\n (setq pt3 (trans pt3 1 0))
\n (mapcar ‘ENT:MAKE_LINE (list pt1 pt2 pt3) (list pt2 pt3 pt1))
\n (if (setq res (ELL:SteinerEllipse pt1 pt2 pt3))
\n (if (setq ent (apply ‘ENT:MAKE_ELLIPSE res))
\n (progn
\n (setq obj (vlax-ename->vla-object ent))
\n (vla-copy obj)
\n (vla-scaleentity obj (vlax-3d-point (car res)) 2)
\n )
\n )
\n (princ “nInvalid input!”)
\n )
\n (princ)
\n)<\/p>\n

;|
\n1. \u56db\u70b9\u753b\u6c34\u5e73\u692d\u5706\u3002
\nhttp:\/\/bbs.mjtd.com\/thread-91856-1-1.html
\n2. \u5df2\u77e5\u692d\u5706\u7684\u5706\u5fc3\u548c\u692d\u5706\u4e0a\u7684\u4e09\u70b9\u521b\u5efa\u4e00\u4e2a\u692d\u5706\u3002
\nhttp:\/\/bbs.mjtd.com\/thread-91856-1-1.html
\n3. \u5df2\u77e5\u692d\u5706\u7684\u56db\u6761\u5207\u7ebf\u521b\u5efa\u4e00\u4e2a\u6c34\u5e73\u692d\u5706\u3002
\nhttp:\/\/bbs.mjtd.com\/forum.php?mod=viewthread&tid=55068
\n4. \u8fc7\u4e94\u70b9\u753b\u692d\u5706\uff0c\u6b64\u95ee\u9898\u6ca1lisp\u7a0b\u5e8f\uff0c\u4f46\u6709\u51e0\u4f55\u89e3\u6cd5\uff0c\u53c2\u89c1\uff1a
\nhttp:\/\/bbs.mjtd.com\/forum.php?mod=viewthread&tid=77145&page=1#pid410208
\n|;<\/p>\n

;|\u516b \u692d\u5706\u62df\u5408\u95ee\u9898\uff1a
\nhttp:\/\/bbs.mjtd.com\/thread-56692-1-1.html
\n\u4e0b\u9762\u7684\u5e16\u5b50\u662f\u7528\u5706\u5f27\u62df\u5408\u692d\u5706\u7684\u8ba8\u8bba\uff1a
\nhttp:\/\/bbs.mjtd.com\/thread-86496-3-1.html
\n|;<\/p>\n

;|\u5341\u4e00 \u6700\u4f3c\u5706\u692d\u5706\u95ee\u9898
\nhttp:\/\/bbs.mjtd.com\/thread-62903-1-1.html
\n|;<\/p>\n

;;;=====================================================================
\n;;;\u8fc7\u56db\u70b9\u7684\u6700\u63a5\u8fd1\u5706\u7684\u692d\u5706
\n;;;=====================================================================
\n(defun Ell:NearToCircleEllipse (Pa Pb Pc Pd \/ CCC InC Pd1 Pe Pe1)
\n (setq CCC (Tri:CircumCenter Pa Pb Pc))
\n (setq InC (Tri:InCenter Pa Pb Pc))
\n (setq Pd1 (Tri:Isogonal-Conjugate-Point-1 Pd Pa Pb InC))
\n (setq Pe (polar Pd1 (+ (angle Pd1 CCC) (\/ pi 2)) 1))
\n (setq Pe1 (Tri:Isogonal-Conjugate-Point-1 Pe Pa Pb InC))
\n (ELL:5PEllipse pa pb pc pd pe1)
\n)<\/p>\n

;semiminor axis semimajor axis
\n;;;\u6d4b\u8bd5\u7a0b\u5e8f
\n(defun c:test7 (\/ pa pb pc pd ret)
\n (initget 1)
\n (setq pa (getpoint “n\u8f93\u5165\u7b2c\u4e00\u70b9:”))
\n (initget 1)
\n (setq pb (getpoint “n\u8f93\u5165\u7b2c\u4e8c\u70b9:”))
\n (initget 1)
\n (setq pc (getpoint “n\u8f93\u5165\u7b2c\u4e09\u70b9:”))
\n (initget 1)
\n (setq pd (getpoint “n\u8f93\u5165\u6620\u5c04\u70b9:”))<\/p>\n

(Ent:Make_Poly (list pa pb pc pd))
\n (setq ret (Ell:NearToCircleEllipse Pd pa pb pc))
\n (and ret (apply ‘Ent:Make_Ellipse ret))
\n ;;(setq InC (Tri:InCenter pa pb pc))
\n ;;(setq CCC (Tri:CircumCenter pa pb pc))
\n ;;(setq Pd1 (Tri:Isogonal-Conjugate-Point Pd Pa Pb Pc))
\n ;;(mapcar ‘Ent:Make_Point (list pa pb pc pd Inc CCC Pd1))<\/p>\n

(princ)
\n)<\/p>\n

;|\u5341\u4e8c \u692d\u5706JIG \u6559\u7a0b
\n;;;http:\/\/bbs.mjtd.com\/forum.php?mod=viewthread&tid=66579
\n|;<\/p>\n

;|\u5341\u4e09 \u692d\u5706\u7684UCS\u6295\u5f71
\nhttp:\/\/bbs.mjtd.com\/forum.php?mod=viewthread&tid=84527
\nhttp:\/\/www.theswamp.org\/index.php?topic=43031.0
\n|;<\/p>\n

;;;=====================================================================
\n;;;\u628a\u4ee5\u524d\u7528\u591a\u6bb5\u7ebf\u753b\u7684\u692d\u5706\u6539\u6210\u771f\u5b9e\u7684\u692d\u5706\u3002
\n;;;=====================================================================
\n(defun ELL:GetEllipseFromPoly (poly \/ pts pt0 pt1 pt2 pt3 cen a b rat maj)
\n (defun Get-3dpoly-Coordinates (poly \/ v e l)
\n (setq v (entnext poly))
\n (while (\/= (cdr (assoc 0 (setq e (entget v)))) “SEQEND”)
\n (setq l (cons (cdr (assoc 10 e)) l)
\n v (entnext v)
\n )
\n )
\n (reverse l)
\n )
\n (setq pts (Get-3dpoly-Coordinates poly))
\n (setq pt0 (car pts))
\n (setq pt1 (nth 4 pts))
\n (setq pt2 (nth 8 pts))
\n (setq pt3 (nth 12 pts))
\n (setq cen (mapcar ‘* (mapcar ‘+ pt0 pt2) ‘(0.5 0.5 0.5)))
\n (setq a (distance cen pt0))
\n (setq b (distance cen pt1))
\n (setq rat (\/ b a))
\n (setq maj (mapcar ‘- pt0 cen))
\n (list cen maj rat)
\n)
\n;;;\u6d4b\u8bd5\u7a0b\u5e8f
\n(defun c:test6(\/ pl ret)
\n (setq pl (car (entsel)))
\n (setq ret (ELL:GetEllipseFromPoly pl))
\n (entmakeX
\n (list
\n ‘(0 . “ELLIPSE”)
\n ‘(100 . “AcDbEntity”)
\n ‘(100 . “AcDbEllipse”)
\n (cons 10 (car ret))
\n (cons 11 (cadr ret))
\n (cons 40 (caddr ret))
\n )
\n )
\n (princ)
\n)<\/p>\n

;;;=====================================================
\n;;; Romberg Integration
\n;;; \u9f99\u8d1d\u683c\u79ef\u5206\u6cd5
\n;;;=====================================================
\n(defun Math:Romberg (a b eps \/ EP H I K M N P Q S X Y Y0)
\n (setq h (- b a))
\n (setq y nil)
\n (setq i 0)
\n (repeat 20
\n (setq y (cons (cons i 0.0) y))
\n (setq i (1+ i))
\n )
\n (setq y (reverse y))
\n (setq y0 (* h (+ (func a) (func b)) 0.5))
\n (setq y (cons (cons 0 y0) (cdr y)))
\n (setq m 1
\n n 1
\n ep (1+ eps)
\n )
\n (while (and (>= ep eps) (<= m 19))
\n (setq p 0.0)
\n (setq i 0)
\n (repeat n
\n (setq x (+ a (* (+ i 0.5) h)))
\n (setq p (+ p (func x)))
\n (setq i (1+ i))
\n )
\n (setq p (\/ (+ (cdar y) (* h p)) 2.0))
\n (setq s 1.0)
\n (setq k 1)
\n (repeat m
\n (setq s (+ s s s s))
\n (setq q (\/ (- (* s p) (cdr (assoc (1- k) y))) (1- s)))
\n (setq y (subst (cons (1- k) p) (assoc (1- k) y) y))
\n (setq p q)
\n (setq k (1+ k))
\n )
\n (setq ep (abs (- q (cdr (assoc (1- m) y)))))
\n (setq m (1+ m))
\n (setq y (subst (cons (1- m) q) (assoc (1- m) y) y))
\n (setq n (+ n n))
\n (setq h (\/ h 2.0))
\n )
\n q
\n)
\n[\/codesyntax]<\/p>\n","protected":false},"excerpt":{"rendered":"

\u5bf9\u692d\u5706\u7684\u7814\u7a76\u3002\u5176\u4e2d\u6709\u5927\u91cf\u7684\u4f7f\u7528\u51fd\u6570\uff1a \u5305\u62ec\u692d\u5706\u7684\u5c55\u5f00\uff0c\u692d\u5706\u7684\u76f8\u4ea4\uff0c\u692d\u5706\u7684\u4f5c\u56fe\uff0c\u692d\u5706\u7684\u9762\u79ef\uff0c\u5468\u957f\u7b97\u6cd5\u4ee5\u53ca\u4e0e\u692d\u5706\u76f8<\/p>\n

Read More<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"ngg_post_thumbnail":0,"footnotes":""},"categories":[9],"tags":[29],"class_list":["post-1299","post","type-post","status-publish","format-standard","hentry","category-programming","tag-29"],"_links":{"self":[{"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/1299","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=1299"}],"version-history":[{"count":0,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/1299\/revisions"}],"wp:attachment":[{"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=1299"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=1299"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=1299"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}