{"id":507,"date":"2007-04-16T23:48:34","date_gmt":"2007-04-16T15:48:34","guid":{"rendered":"https:\/\/www.highflybird.com\/blog\/?p=226"},"modified":"2020-02-29T22:55:34","modified_gmt":"2020-02-29T14:55:34","slug":"%e5%87%b8%e5%8c%85%e7%9a%84lisp%e5%ae%9e%e7%8e%b0","status":"publish","type":"post","link":"https:\/\/www.highflybird.com\/blog\/?p=507","title":{"rendered":"\u51f8\u5305\u7684LISP\u5b9e\u73b0"},"content":{"rendered":"<p>\u5173\u4e8e\u51f8\u5305\u7684\u7ef4\u57fa\u89e3\u91ca\uff1a\u5728\u4e00\u4e2a\u5b9e\u6570\u5411\u91cf\u7a7a\u95f4V\u4e2d\uff0c\u5bf9\u4e8e\u7ed9\u5b9a\u96c6\u5408X\uff0c\u6240\u6709\u5305\u542bX\u7684\u51f8\u96c6\u7684\u4ea4\u96c6S\u88ab\u79f0\u4e3aX\u7684\u51f8\u5305\u3002<\/p>\n<p>\u51f8\u5305\u6709\u5f88\u591a\u7528\u9014\uff0c\u7f51\u4e0a\u6d41\u4f20\u7740\u5f88\u591a\u5176\u4ed6\u8bed\u8a00\u7684\u4ee3\u7801\uff0cLISP\u7684\u5374\u5f88\u5c11\uff0c\u4e0b\u9762\u662f\u6211\u7684LISP\u5b9e\u73b0\u4ee3\u7801\uff1a<\/p>\n<p><!--more--><\/p>\n<pre lang=\"lisp\" line=\"1\" escaped=\"true\">;;;************************************************************************\n;;;\u4e00\u4e2a\u6c42\u70b9\u96c6\u5408\u7684\u51f8\u5305\u7684lisp\u7a0b\u5e8f--------------------------------------------\n;;;\u91c7\u7528\u7684\u7b97\u6cd5\u4e3aGraham\u626b\u63cf\u6cd5,\u5177\u4f53\u65b9\u6cd5\u89c1\u6ce8\u91ca---------------------------------\n;;;\u53c2\u8003\u6587\u732e&lt;&lt;\u8ba1\u7b97\u51e0\u4f55-\u7b97\u6cd5\u53ca\u5176\u5e94\u7528&gt;&gt;(\u7b2c\u4e8c\u7248),\u4ee5\u53ca\u53c2\u8003\u4e86\u5176\u4ed6\u7f51\u7ad9\u7684\u4e00\u4e9b\u6e90\u4ee3\u7801\n;;;\u7528\u6cd5: \u52a0\u8f7d\u8fd0\u884c\u7a0b\u5e8f\u540e\uff0c\u9009\u53d6\u70b9\uff0c\u76f4\u7ebf\u6bb5\uff0c\u6216\u591a\u4e49\u7ebf(\u5168\u662f\u76f4\u7ebf\u6bb5\u7ec4\u6210)\u5373\u53ef\u3002----\n;;;************************************************************************\n(defun C:test1 (\/ fil sel t0 ptlist pp 2Pi)\n  (setq fil '((0 . \"POINT,LINE,POLYLINE,LWPOLYLINE\")))\n  (setq sel (ssget fil))                ;\u9009\u62e9\u70b9\u96c6\n  (setq ptlist (getpt sel))             ;\u6784\u9020\u70b9\u96c6\n  (setq t0 (getvar \"TDUSRTIMER\"))       ;\u5f00\u59cb\u8ba1\u65f6\n  (setq pp (Graham-scan ptlist))        ;\u6c42\u51f8\u5305\n  (princ \"n\u7528\u65f6\")\n  (princ (* (- (getvar \"TDUSRTIMER\") t0) 86400)) ;\u7ed3\u675f\u8ba1\u65f6\n  (princ \"\u79d2\")\n  (if (null pp)\n    (alert \"\u70b9\u7684\u6709\u6548\u6570\u76ee\u592a\u5c0f\uff0c\u8bf7\u91cd\u65b0\u8f93\u5165!\")\n    (MAKE-POLY PP)\n  )\n  (gc)\n  (princ)\n)\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 (&lt; (length ptlist) 3)             ;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 (&gt; (det 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)\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 (ptlist pt \/ Ang1 Ang2)\n  (vl-sort ptlist\n           (function\n             (lambda (e1 e2)\n               (setq ang1 (angle pt e1))\n               (setq ang2 (angle pt e2))\n               (if (= ang1 ang2)\n                 (&lt; (distance pt e1) (distance pt e2))\n                 (&lt; ang1 ang2)\n               )\n             )\n           )\n  )\n)\n(defun sort-by-angle (ptlist pt \/ Ang1 Ang2)\n  (vl-sort ptlist\n           (function\n             (lambda (e1 e2) (&lt; (angle pt e1) (angle pt e2)))\n           )\n  )\n)\n(defun sort-XY (ptlist)\n  (vl-sort ptlist\n           (function\n             (lambda (e1 e2)\n               (if (equal (cadr e1) (cadr e2) 1e-8)\n                 (&gt; (car e1) (car e2))\n                 (&lt; (cadr e1) (cadr e2))\n               )\n             )\n           )\n  )\n)\n;;\u5b9a\u4e49\u4e09\u70b9\u7684\u884c\u5217\u5f0f,\u5373\u4e09\u70b9\u4e4b\u500d\u9762\u79ef\n(defun det (p1 p2 p3 \/ x2 y2)\n  (setq x2 (car p2)\n        y2 (cadr p2)\n  )\n  (- (* (- x2 (car p3)) (- y2 (cadr p1)))\n     (* (- x2 (car p1)) (- y2 (cadr p3)))\n  )\n)\n;;;============\n;;;\u7a0b\u5e8f\u4e3b\u6bb5\u7ed3\u675f\n;;;============\n\n;;;\u53d6\u70b9\u51fd\u65701\n(defun getpt1 (ss \/ i listpp a b c d)\n  (setq i 0)\n  (if ss\n    (repeat (sslength ss)\n      (setq a (ssname ss i))\n      (setq b (entget a))\n      (setq c (cdr (assoc 10 b)))\n      (setq c (list (car c) (cadr c)))\n      (setq listpp (cons c listpp))\n      (setq i (1+ i))\n    )\n  )\n  listpp\n)\n;;;\u53d6\u70b9\u51fd\u65702\n(defun getpt (ss \/ i listpp a b c d)\n  (setq i 0)\n  (if ss\n    (repeat (sslength ss)\n      (setq a (ssname ss i))\n      (setq b (entget a))\n      (setq ename (cdr (assoc 0 b)))\n      (cond\n        ((= ename \"LWPOLYLINE\")\n         (setq c (get-LWpolyline-vertexs b))\n         (setq listpp (append c listpp))\n        )\n        ((= ename \"LINE\")\n         (setq c (cdr (assoc 10 b)))\n         (setq d (cdr (assoc 11 b)))\n         (setq c (list (car c) (cadr c)))\n         (setq d (list (car d) (cadr d)))\n         (setq listpp (cons c listpp))\n         (setq listpp (cons d listpp))\n        )\n        ((= ename \"POINT\")\n         (setq c (cdr (assoc 10 b)))\n         (setq c (list (car c) (cadr c)))\n         (setq listpp (cons c listpp))\n        )\n      )\n      (setq i (1+ i))\n    )\n  )\n  listpp\n)\n(DEFUN make-poly (pp \/ X)\n  (entmake                              ;\u753b\u51f8\u5305\n    (append\n      '((0 . \"LWPOLYLINE\")\n        (100 . \"AcDbEntity\")\n        (100 . \"AcDbPolyline\")\n       )\n      (list (cons 90 (length pp)))      ;\u9876\u70b9\u4e2a\u6570\n      (mapcar\n        (function (lambda (x) (cons 10 x)))\n        pp\n      )                                 ;\u591a\u6bb5\u7ebf\u9876\u70b9\n      (list (cons 70 1))                ;\u95ed\u5408\u7684\n      (list (cons 62 1))                ;\u7ea2\u8272\u7684\n    )\n  )\n)\n;;\u53d6\u5f97\u591a\u8fb9\u5f62\u9876\u70b9\n(defun get-LWpolyline-vertexs (entlst \/ n lst)\n  (foreach n entlst\n    (if (= (car n) 10)\n      (setq lst (cons (cdr n) lst))\n    )\n  )\n  (reverse lst)\n)\n<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>\u5173\u4e8e\u51f8\u5305\u7684\u7ef4\u57fa\u89e3\u91ca\uff1a\u5728\u4e00\u4e2a\u5b9e\u6570\u5411\u91cf\u7a7a\u95f4V\u4e2d\uff0c\u5bf9\u4e8e\u7ed9\u5b9a\u96c6\u5408X\uff0c\u6240\u6709\u5305\u542bX\u7684\u51f8\u96c6\u7684\u4ea4\u96c6S\u88ab\u79f0\u4e3aX\u7684\u51f8\u5305\u3002 \u51f8\u5305\u6709\u5f88<\/p>\n<p class=\"more-link\"><a href=\"https:\/\/www.highflybird.com\/blog\/?p=507\" class=\"themebutton2\">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":[16],"class_list":["post-507","post","type-post","status-publish","format-standard","hentry","category-programming","tag-16"],"_links":{"self":[{"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/507","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=507"}],"version-history":[{"count":0,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=\/wp\/v2\/posts\/507\/revisions"}],"wp:attachment":[{"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=507"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=507"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.highflybird.com\/blog\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=507"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}