{"id":1291,"date":"2006-11-11T01:10:17","date_gmt":"2006-11-10T17:10:17","guid":{"rendered":"https:\/\/www.highflybird.com\/blog\/?p=115"},"modified":"2020-02-29T22:47:55","modified_gmt":"2020-02-29T14:47:55","slug":"%e7%82%b9%e9%9b%86%e7%9a%84%e6%9c%80%e5%b0%8f%e5%8c%85%e5%9b%b4%e5%9c%86%e7%94%a8lisp%e6%b1%82%e8%a7%a3","status":"publish","type":"post","link":"https:\/\/www.highflybird.com\/blog\/?p=1291","title":{"rendered":"\u70b9\u96c6\u7684\u6700\u5c0f\u5305\u56f4\u5706(\u7528LISP\u6c42\u89e3)"},"content":{"rendered":"<p>\u8fd9\u91cc\u662f\u4e00\u4e2a\u7ecf\u5178\u7684\u51e0\u4f55\u7b97\u6cd5\u9898\u76ee\uff0c\u5728CAD\u73af\u5883\u4e0b\u7528LISP\u7f16\u5199\u3002<br \/>\n\u529f\u80fd\u662f\u6c42\u8986\u76d6\u70b9\u96c6\u7684\u6700\u5c0f\u7684\u5706\u3002<br \/>\n<!--more--><\/p>\n<pre lang=\"lisp\">;;;************************************\n;;;\u6c42\u6700\u5c0f\u5305\u56f4\u5706\u7684lisp\u7a0b\u5e8f--------------\n;;;\u5176\u7b97\u6cd5\u4e3a\u53c2\u89c1\u4e86\u6709\u5173\u6587\u732e--------------\n;;;\u8fd9\u79cd\u7b97\u6cd5\u5728\u9000\u5316\u5f88\u4e25\u91cd\u7684\u60c5\u51b5\u7ed3\u679c\u4e5f\u6b63\u786e\n;;;\u5176\u4e2d\u7a0b\u5e8f\u4e3b\u6bb5\u662f\u6838\u5fc3\u7b97\u6cd5\uff0c\u5176\u4ed6\u7684\u9644\u52a0\u7a0b\n;;;\u5e8f\u4e3a\u53d6\u70b9\uff0c\u753b\u70b9\uff0c\u753b\u5706\u548c\u534a\u5f84\uff0c\u7528\u6765\u6d4b\u8bd5\n;;;************************************\n(defun C:test (\/ )\n  ;;\u53d6\u70b9\uff0c\u753b\u70b9\uff0c\u5e76\u5bf9\u51fd\u6570\u7528\u65f6\u8ba1\u7b97-------\n  (setq ss (ssget '((0 . \"POINT,LINE,POLYLINE,LWPOLYLINE\"))))\n  (setq pts (ssgetpoint ss))\n  (setq t0 (getvar \"TDUSRTIMER\"))\n  ;;(setq x (mincir pts))\n  (setq x (mdesc pts nil))\n  (princ \"n\u7528\u65f6\")\n  (princ (* (- (getvar \"TDUSRTIMER\") t0) 86400)) ;\u7ed3\u675f\u8ba1\u65f6\n  (princ \"\u79d2\")\n  (if (null x)\n    (alert \"\u70b9\u7684\u6709\u6548\u6570\u76ee\u592a\u5c0f\uff0c\u8bf7\u91cd\u65b0\u8f93\u5165!\")\n    (progn\n      (setq cen\t  (car x)\n\t    rad   (cdr x)\n\t    ;;rad\t  (cadr x)\n\t    ;;ptmax (caddr x)\n      )\n      ;;\u753b\u5706\u53ca\u534a\u5f84\uff0c\u5217\u51fa\u5706\u7684\u5706\u5fc3\u534a\u5f84\u503c\n      (make-circle cen rad)\n      ;;(make-line cen ptmax)\n    )\n  )\n  (princ)\n)\n;;;************************************\n;;;\u6c42\u6700\u5c0f\u5305\u56f4\u5706\u7684\u51fd\u6570\uff0c\u7a7a\u96c6\u8fd4\u56de\u7a7a\u96c6\uff0c\u5426\n;;;\u5219\u8fd4\u56de\u6700\u5c0f\u5706\u7684\u5706\u5fc3\uff0c\u534a\u5f84\u548c\u5706\u4e0a\u7684\u4e00\u70b9\n;;;\u8fd9\u662f\u7a0b\u5e8f\u7684\u4e3b\u6bb5----------------------\n;;;************************************\n(defun mincir (ptlist \/ CEN CEN_R P1 P2 P3 PTMAX R rad X i)\n  ;;\u5224\u65ad\u6709\u6548\u70b9\u4e2a\u6570---------------------\n  (cond\n    ((= (length ptlist) 0)\n     nil\n    )\n    ((= (length ptlist) 1)\n     (alert \"\u70b9\u96c6\u4e3a\u4e00\u70b9,\u6700\u5c0f\u5706\u534a\u5f84\u4e3a0\")\n     (list (car ptlist) 0 (car ptlist))\n    )\n    ((= (length ptlist) 2)\n     (alert \"\u70b9\u96c6\u4e3a\u4e24\u70b9\uff0c\u6700\u5c0f\u5706\u4e3a\u8fc7\u4e24\u70b9\u7684\u5706\")\n     (setq cen (mid (car ptlist) (cadr ptlist))\n\t   rad (\/ (distance (car ptlist) (cadr ptlist)) 2)\n     )\n     (list cen rad (car ptlist))\n    )\n    (t\n     ;;\u5f00\u59cb\u9012\u5f52\u8fd0\u7b97----------------------------\n     (setq p1 (car ptlist)\n\t   p2 (cadr ptlist)\n\t   p3 (caddr ptlist)\n     )\n     (setq cen_r (3pc p1 p2 p3))\n     (setq ptmax (maxd-cir ptlist (car cen_r)))\n     (setq i 0)\n     (while (null (in1 ptmax (car cen_r) (cadr cen_r)))\n       (setq cen_r (4pc p1 p2 p3 ptmax))\n       (setq p1\t(car (caddr cen_r))\n\t     p2\t(cadr (caddr cen_r))\n\t     p3\t(caddr (caddr cen_r))\n       )\n       (setq ptmax (maxd-cir ptlist (car cen_r)))\n       (setq i (1+ i))\n     )\n     (list (car cen_r) (cadr cen_r) ptmax)\n    )\n  )\n)\n(defun make-circle (cen rad)\n  (entmake\n    (list\n      '(0 . \"circle\")\n      (cons 10 cen)\n      (cons 40 rad)\n      (cons 62 1)\n    )\n  )\n)\n(defun make-line (p q)\n  (entmake\n    (list\n      '(0 . \"LINE\")\n      (cons 10 p)\n      (cons 11 q)\n    )\n  )\n)\n;;\u4ee5\u4e0b\u4ee3\u7801\u6765\u81ea\u6653\u4e1c\n;;\u5b9a\u4e49\u53d6\u70b9\u51fd\u6570----\n(defun ssgetpoint (ss \/ i l a b c)\n  (setq i 0)\n  (if ss\n    (repeat (sslength ss)\n      (setq a (ssname ss i))\n      (setq i (1+ i))\n      (setq b (entget a))\n      (setq c (cdr (assoc 10 b)))\n      (setq l (cons c l))\n    )\n  )\n  (reverse l)\n)\n;;;\n(defun mid (p1 p2)\n  (list\n    (* (+ (car p1) (car p2)) 0.5)\n    (* (+ (cadr p1) (cadr p2)) 0.5)\n    (* (+ (caddr p1) (caddr p2)) 0.5)\n  )\n)\n;;;\u5224\u65ad\u70b9\u662f\u5426\u5728\u5706\u5185------------------------\n(defun in1 (pt cen r)\n  (&lt; (- (distance pt cen) r) 1e-8)\n)\n;;;\u5224\u65ad\u70b9\u96c6\u662f\u5426\u5728\u5706\u5185----------------------\n(defun in2 (ptl cen r \/ pts pt)\n  (setq pts ptl)\n  (while (and (setq pt (car pts))\n\t      (in1 pt cen r)\n\t )\n    (setq pts (cdr pts))\n  )\n  (null pt)\n)\n;;;\u5b9a\u4e49\u4e09\u70b9\u6700\u5c0f\u5706\u5706\u5fc3\u53ca\u5176\u534a\u5f84\uff0c\u82e5\u662f\u9510\u89d2\u4e09\u89d2\n;;;\u5f62\uff0c\u5219\u662f\u5176\u4e09\u70b9\u5706\uff0c\u5426\u5219\u662f\u5176\u6700\u5927\u8fb9\u7684\u76f4\u5f84\u5706\n(defun 3pc (pa pb pc \/ D MIDPT)\n  (cond\n    ( (in1 pc (setq midpt (mid pa pb)) (setq d (\/ (distance pa pb) 2)))\n      (list midpt d (list pa pb pc))\n    )\n    ( (in1 pa (setq midpt (mid pb pc)) (setq d (\/ (distance pb pc) 2)))\n      (list midpt d (list pb pc pa))\n    )\n    ( (in1 pb (setq midpt (mid pc pa)) (setq d (\/ (distance pc pa) 2)))\n      (list midpt d (list pc pa pb))\n    )\n    (t\n      (3pcircle pa pb pc)\n    )\n  )\n)\n;;; \u4e09\u70b9\u5706\u51fd\u6570\n(defun 3PCirCle(P0 P1 P2 \/ X0 Y0 X1 Y1 X2 Y2 DX1 DY1 DX2 DY2 D 2D C1 C2 CE)\n  (setq\tX0  (car P0)\n\tY0  (cadr P0)\n\tX1  (car P1)\n\tY1  (cadr P1)\n\tX2  (car P2)\n\tY2  (cadr P2)\n\tDX1 (- X1 X0)\n\tDY1 (- Y1 Y0)\n\tDX2 (- X2 X0)\n\tDY2 (- Y2 Y0)\n  )\n  (setq D (- (* DX1 DY2) (* DX2 DY1)))\n  (if (\/= D 0.0)\n    (progn\n      (setq 2D (+ D D)\n\t    C1 (+ (* DX1 (+ X0 X1)) (* DY1 (+ Y0 Y1)))\n\t    C2 (+ (* DX2 (+ X0 X2)) (* DY2 (+ Y0 Y2)))\n\t    CE (List (\/ (- (* C1 DY2) (* C2 DY1)) 2D)\n\t\t     (\/ (- (* C2 DX1) (* C1 DX2)) 2D)\n\t       )\n      )\n      (list CE (distance CE P0) (list p0 p1 p2))\n    )\n  )\n)\n;;;\u5b9a\u4e49\u56db\u70b9\u7684\u6700\u5c0f\u5706\u5706\u5fc3\u534a\u5f84\uff0c\u5e76\u8fd4\u56de\u4e09\u70b9\u5750\u6807\n(defun 4pc (p1 p2 p3 ptmax \/ pts mind minr r 4ps)\n  (setq\tpts (list (3pc p1 p2 ptmax)\n\t\t  (3pc p1 p3 ptmax)\n\t\t  (3pc p2 p3 ptmax)\n\t    )\n  )\n  (setq 4ps (list p1 p2 p3 ptmax))\n  (setq minr 1e308)\n  (foreach n pts\n    (setq r (cadr n))\n    (if\t(and (&lt; r minr)\n\t     (in2 4ps (car n) r)\n\t)\n      (setq mind n)\n    )\n  )\n  mind\n)\n\n;;\u5b9a\u4e49\u6c42\u70b9\u96c6\u4e2d\u79bb\u5706\u5fc3\u6700\u8fdc\u7684\u70b9\u7684\u51fd\u6570--------\n(defun maxd-cir\t(ptl cen \/ pmax dmax d)\n  (setq dmax 0.0)\n  (foreach pt ptl\n    (if\t(&gt; (setq d (distance pt cen)) dmax)\n      (setq dmax d\n\t    pmax pt\n      )\n    )\n  )\n  pmax\n)\n;;;\u968f\u673a\u589e\u91cf\u6cd5\n(defun Mdesc (pts sup \/ s p c)\n  (if (setq s pts)\n    (progn\n      ;;(setq p (GetRandomElementOf pts))\n      (setq p (car s))\n      (setq s (cdr s))\n      (setq c (mdesc s sup))\n      (if (Inside p c)\n\tC\n\t(mdesc s (cons p sup))\n      )\n    )\n    (Circle Sup)\n  )\n)\n;;;\u968f\u673a\u589e\u91cf\u6cd5\n(defun Circle (Sup \/ n p1 p2 p3 CR)\n  (setq n (length sup))\n  (cond\n    ( (= n 1)\n      (cons (car sup) 0)\n    ) \n    ( (= n 2)\n      (setq p1 (car sup))\n      (setq p2 (cadr sup))\n      (cons (mid p1 p2) (\/ (distance p1 p2) 2))\n    )\n    ( (= n 3)\n      (setq p1 (car sup))\n      (setq p2 (cadr sup))\n      (setq p3 (caddr sup))\n      (setq CR (3pCirCle p1 p2 p3))\n      (cons (car CR) (cadr CR))\n    )\n    (t nil) \n  )\n)\n(defun Inside (p C)\n  (if c \n    (&lt; (- (distance p (car C)) (cdr C)) 1e-8)\n  )  \n)  \n<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>\u8fd9\u91cc\u662f\u4e00\u4e2a\u7ecf\u5178\u7684\u51e0\u4f55\u7b97\u6cd5\u9898\u76ee\uff0c\u5728CAD\u73af\u5883\u4e0b\u7528LISP\u7f16\u5199\u3002 \u529f\u80fd\u662f\u6c42\u8986\u76d6\u70b9\u96c6\u7684\u6700\u5c0f\u7684\u5706\u3002<\/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":[25],"class_list":["post-1291","post","type-post","status-publish","format-standard","hentry","category-programming","tag-25"],"_links":{"self":[{"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/1291","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=1291"}],"version-history":[{"count":0,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/1291\/revisions"}],"wp:attachment":[{"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=1291"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=1291"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=1291"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}