\u5bf9CAD\u4e2d \u5173\u4e8e\u76f4\u7ebf\uff0c\u70b9\uff0c\u7ebf\u6bb5\u7684\u4e00\u4e9b\u7814\u7a76\uff0c\u5305\u542b\u4e86\u5927\u91cf\u5b9e\u7528\u51fd\u6570\u3002
\n\u5176\u4e2d\u70b9\u7684\u5b9a\u5206\u6bd4\uff0c\u76f4\u7ebf\u7684\u76f8\u4ea4\uff0c\u4ee5\u53ca\u7a7a\u95f4\u76f4\u7ebf\u7684\u76f8\u4ea4\uff0c\u4e09\u89d2\u5f62\u7684\u5468\u957f\uff0c\u9762\u79ef\u7b49\u5404\u79cd\u6027\u8d28\u7684\u6570\u5b66\u7b97\u6cd5\uff0c\u591a\u6bb5\u7ebf\u7684\u9762\u79ef\uff0c\u8d28\u5fc3\u7684\u6570\u5b66\u7b97\u6cd5\uff0c\u70b9\u7ebf\u9762\u7684\u4e00\u4e9b\u57fa\u672c\u51e0\u4f55\u5173\u7cfb\u3002\u7b49\u7b49\u3002
\n\u4e0b\u9762\u662f\u76f8\u5173\u7684\u4ee3\u7801\u3002
\n<\/p>\n
;|*********************************************************************************************;\n\u8f6f\u4ef6\u4f5c\u8005: Highflybird ;\n\u8f6f\u4ef6\u7528\u9014: \u4e3aAutoCAD \u7684LISP\u5b9a\u5236\u7684\u4e00\u4e9b\u7b97\u6cd5\u548c\u51fd\u6570 ;\n\u65e5\u671f\u5730\u70b9: 2012.12.12 \u6df1\u5733 ;\n\u7a0b\u5e8f\u8bed\u8a00: AutoLISP,Visual LISP ;\n\u7248\u672c\u53f7: Ver. 1.0.121212 ;\n===============================================================================================;\n\u672c\u8f6f\u4ef6\u4e3a\u5f00\u6e90\u8f6f\u4ef6: \u4ee5\u4e0b\u662f\u5f00\u6e90\u7533\u660e: \n-----------------------------------------------------------------------------------------------;\n\u672c\u9875\u9762\u7684\u8f6f\u4ef6\u9075\u7167GPL\u534f\u8bae\u5f00\u653e\u6e90\u4ee3\u7801\uff0c\u60a8\u53ef\u4ee5\u81ea\u7531\u4f20\u64ad\u548c\u4fee\u6539\uff0c\u5728\u9075\u7167\u4e0b\u9762\u7684\u7ea6\u675f\u6761\u4ef6\u7684\u524d\u63d0\u4e0b: \n \n\u4e00. \u53ea\u8981\u4f60\u5728\u672c\u5f00\u6e90\u8f6f\u4ef6\u7684\u6bcf\u4e00\u526f\u672c\u4e0a\u660e\u663e\u548c\u6070\u5f53\u5730\u51fa\u7248\u7248\u6743\u58f0\u660e\uff0c\u4fdd\u6301\u6b64\u8bb8\u53ef\u8bc1\u7684\u58f0\u660e\u548c\u6ca1\u6709\u62c5\u4fdd\u7684\u58f0\u660e\u5b8c\n\u6574\u65e0\u635f\uff0c\u5e76\u548c\u7a0b\u5e8f\u4e00\u8d77\u7ed9\u6bcf\u4e2a\u5176\u4ed6\u7684\u7a0b\u5e8f\u63a5\u53d7\u8005\u4e00\u4efd\u8bb8\u53ef\u8bc1\u7684\u526f\u672c\uff0c\u4f60\u5c31\u53ef\u4ee5\u7528\u4efb\u4f55\u5a92\u4f53\u590d\u5236\u548c\u53d1\u5e03\u4f60\u6536\u5230\u7684\n\u539f\u59cb\u7684\u7a0b\u5e8f\u7684\u6e90\u4ee3\u7801\u3002\u4f60\u4e5f\u53ef\u4ee5\u4e3a\u8f6c\u8ba9\u526f\u672c\u7684\u5b9e\u9645\u884c\u52a8\u6536\u53d6\u4e00\u5b9a\u8d39\u7528\uff0c\u4f46\u5fc5\u987b\u4e8b\u5148\u5f97\u5230\u7684\u540c\u610f\u3002 \n \n\u4e8c. \u4f60\u53ef\u4ee5\u4fee\u6539\u672c\u5f00\u6e90\u8f6f\u4ef6\u7684\u4e00\u4e2a\u6216\u51e0\u4e2a\u526f\u672c\u6216\u7a0b\u5e8f\u7684\u4efb\u4f55\u90e8\u5206\uff0c\u4ee5\u6b64\u5f62\u6210\u57fa\u4e8e\u7a0b\u5e8f\u7684\u4f5c\u54c1\u3002\u53ea\u8981\u4f60\u540c\u65f6\u6ee1\u8db3\n\u4e0b\u9762\u7684\u6240\u6709\u6761\u4ef6\uff0c\u4f60\u5c31\u53ef\u4ee5\u6309\u524d\u9762\u7b2c\u4e00\u6b3e\u7684\u8981\u6c42\u590d\u5236\u548c\u53d1\u5e03\u8fd9\u4e00\u7ecf\u8fc7\u4fee\u6539\u7684\u7a0b\u5e8f\u6216\u4f5c\u54c1\u3002 \n1.\u4f60\u5fc5\u987b\u5728\u4fee\u6539\u7684\u6587\u4ef6\u4e2d\u9644\u6709\u660e\u786e\u7684\u8bf4\u660e: \u4f60\u4fee\u6539\u4e86\u8fd9\u4e00\u6587\u4ef6\u53ca\u5177\u4f53\u7684\u4fee\u6539\u65e5\u671f\u3002 \n2.\u4f60\u5fc5\u987b\u4f7f\u4f60\u53d1\u5e03\u6216\u51fa\u7248\u7684\u4f5c\u54c1\uff08\u5b83\u5305\u542b\u7a0b\u5e8f\u7684\u5168\u90e8\u6216\u4e00\u90e8\u5206\uff0c\u6216\u5305\u542b\u7531\u7a0b\u5e8f\u7684\u5168\u90e8\u6216\u90e8\u5206\u884d\u751f\u7684\u4f5c\u54c1\uff09\u5141\u8bb8\n \u7b2c\u4e09\u65b9\u4f5c\u4e3a\u6574\u4f53\u6309\u8bb8\u53ef\u8bc1\u6761\u6b3e\u514d\u8d39\u4f7f\u7528\u3002 \n3.\u5982\u679c\u4fee\u6539\u7684\u7a0b\u5e8f\u5728\u8fd0\u884c\u65f6\u4ee5\u4ea4\u4e92\u65b9\u5f0f\u8bfb\u53d6\u547d\u4ee4\uff0c\u4f60\u5fc5\u987b\u4f7f\u5b83\u5728\u5f00\u59cb\u8fdb\u5165\u5e38\u89c4\u7684\u4ea4\u4e92\u4f7f\u7528\u65b9\u5f0f\u65f6\u6253\u5370\u6216\u663e\u793a\u58f0\n \u660e: \u5305\u62ec\u9002\u5f53\u7684\u7248\u6743\u58f0\u660e\u548c\u6ca1\u6709\u62c5\u4fdd\u7684\u58f0\u660e\uff08\u6216\u8005\u4f60\u63d0\u4f9b\u62c5\u4fdd\u7684\u58f0\u660e\uff09\uff1b\u7528\u6237\u53ef\u4ee5\u6309\u6b64\u8bb8\u53ef\u8bc1\u6761\u6b3e\u91cd\u65b0\u53d1\u5e03\n \u7a0b\u5e8f\u7684\u8bf4\u660e\uff1b\u5e76\u544a\u8bc9\u7528\u6237\u5982\u4f55\u770b\u5230\u8fd9\u4e00\u8bb8\u53ef\u8bc1\u7684\u526f\u672c\u3002\uff08\u4f8b\u5916\u7684\u60c5\u51b5: \u5982\u679c\u539f\u59cb\u7a0b\u5e8f\u4ee5\u4ea4\u4e92\u65b9\u5f0f\u5de5\u4f5c\uff0c\u5b83\u5e76\n \u4e0d\u6253\u5370\u8fd9\u6837\u7684\u58f0\u660e\uff0c\u4f60\u7684\u57fa\u4e8e\u7a0b\u5e8f\u7684\u4f5c\u54c1\u4e5f\u5c31\u4e0d\u7528\u6253\u5370\u58f0\u660e\u3002 \n \n\u4e09. \u53ea\u8981\u4f60\u9075\u5faa\u4e00\u3001\u4e8c\u6761\u6b3e\u89c4\u5b9a\uff0c\u60a8\u5c31\u53ef\u4ee5\u81ea\u7531\u4f7f\u7528\u5e76\u4f20\u64ad\u672c\u6e90\u4ee3\u7801\uff0c\u4f46\u5fc5\u987b\u539f\u5c01\u4e0d\u52a8\u5730\u4fdd\u7559\u539f\u4f5c\u8005\u4fe1\u606f\u3002 \n===============================================================================================;\n**********************************************************************************************|;\n\n;;;****************************************************;\n;;;\u51e0\u4f55\u90e8\u5206 ;\n;;;****************************************************;\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u6bd4\u4f8b\u7f29\u653e\u70b9 ;\n;;;\u8f93\u5165: \u8981\u7f29\u653e\u7684\u70b9pt,\u57fa\u70b9pBase\uff0c\u7f29\u653e\u56e0\u5b50k ;\n;;;\u8f93\u51fa: \u7f29\u653e\u540e\u7684\u70b9\u4f4d\u7f6e ;\n;;;----------------------------------------------------;\n(defun GEO:Scale (Pt pBase k)\n (mapcar (function (lambda (u v) (+ u (* k (- v u))))) pBase Pt)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u6bd4\u4f8b\u7f29\u653e\u70b92\u500d ;\n;;;\u8f93\u5165: \u8981\u7f29\u653e\u7684\u70b9pt,\u57fa\u70b9pBase ;\n;;;\u8f93\u51fa: \u7f29\u653e\u540e\u7684\u70b9\u4f4d\u7f6e ;\n;;;----------------------------------------------------;\n(defun GEO:Scale2 (Pt pBase)\n (mapcar (function (lambda (u v) (+ v (- v u)))) pBase Pt)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e24\u70b9\u4e4b\u4e2d\u70b9 ;\n;;;\u8f93\u5165: \u4e24\u70b9p1,P2 ;\n;;;\u8f93\u51fa: \u4e2d\u70b9\u4f4d\u7f6e ;\n;;;----------------------------------------------------;\n(defun GEO:Midpoint (p1 p2)\n (mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e24\u4e2a\u8ddd\u79bb\u4e4b\u4e2d\u4f4d\u503c ;\n;;;\u8f93\u5165: \u5171\u7ebf\u4e09\u70b9O,P,Q ;\n;;;\u8f93\u51fa: \u4e2d\u4f4d\u70b9\u4f4d\u7f6e ;\n;;;----------------------------------------------------;\n(defun GEO:MeanPoint (O P Q)\n (polar O (angle O P) (sqrt (* (distance O P) (distance O Q))))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u5b9a\u6bd4\u70b9P,\u4f7f\u5f97P1P \/ PP2 = k \uff08\u6b64\u51fd\u6570\u4e8e\u4e09\u7ef4\uff09 ;\n;;;\u8f93\u5165: \u4e24\u70b9p1,P2\u548c\u6bd4\u4f8b\u7cfb\u6570k ;\n;;;\u8f93\u51fa: \u5b9a\u6bd4\u70b9\u4f4d\u7f6e ;\n;;;----------------------------------------------------;\n(defun GEO:Proportion (p1 p2 k)\n (if (\/= k -1)\n (mapcar (function (lambda (x1 x2) (\/ (+ x1 (* k x2)) (+ 1.0 k)))) p1 p2)\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e24\u70b9\u6cd5\u65cb\u8f6c\u67d0\u4e2a\u70b990\u5ea6 ;\n;;;\u8f93\u5165: \u57fa\u70b9\uff0c\u77e2\u91cf\u7684\u7b2c\u4e00\u70b9P1\uff0c\u7b2c\u4e8c\u70b9P1 ;\n;;;\u8f93\u51fa: \u65cb\u8f6c90\u5ea6\u540e\u70b9\u4f4d\u7f6e ;\n;;;----------------------------------------------------;\n(defun GEO:Rot90 (ptBase P1 P2)\n (mapcar '+ ptBase (MAT:Rot90 (mapcar '- p2 p1)))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4ee5\u57fa\u70b9\u65cb\u8f6c\u4e00\u70b9\u5230\u6307\u5b9a\u7684\u89d2\u5ea6 ;\n;;;\u8f93\u5165: \u8981\u65cb\u8f6c\u7684\u70b9Pt\uff0c\u57fa\u70b9\u548c\u65cb\u8f6c\u89d2\u5ea6 ;\n;;;\u8f93\u51fa: \u65cb\u8f6c\u540e\u70b9\u4f4d\u7f6e ;\n;;;----------------------------------------------------;\n(defun GEO:Rot2D (Pt PtBase Ang) \n (mapcar '+ PtBase (MAT:Rot2D (mapcar '- Pt PtBase) Ang))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4ee5\u57fa\u70b9\u548c\u89d2\u5ea6\u955c\u50cf\u67d0\u70b9 ;\n;;;\u8f93\u5165: \u8981\u955c\u50cf\u7684\u70b9Pt\uff0c\u57fa\u70b9\u548c\u955c\u50cf\u8f74\u89d2\u5ea6 ;\n;;;\u8f93\u51fa: \u955c\u50cf\u70b9\u4f4d\u7f6e ;\n;;;\u8bf4\u660e: \u53ea\u9002\u7528\u4e0e\u4e8c\u7ef4\u60c5\u51b5\u4e0b\uff0c\u4f46\u901f\u5ea6\u6700\u5feb ;\n;;;----------------------------------------------------;\n(defun GEO:Mirror2D (Pt pBase Ang)\n (polar pBase (+ ang (- ang (angle pbase pt))) (distance pt pBase))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u955c\u50cf\u70b9\uff08\u53ef\u4ee5\u7528\u4e8e3D\u60c5\u51b5\uff09 ;\n;;;\u8f93\u5165: \u8981\u955c\u50cf\u7684\u70b9Pt\uff0c\u955c\u50cf\u8f74\u7b2c\u4e00\u70b9\u548c\u7b2c\u4e8c\u70b9 ;\n;;;\u8f93\u51fa: \u955c\u50cf\u70b9\u4f4d\u7f6e ;\n;;;\u8bf4\u660e: \u53ef\u4ee5\u9002\u7528\u4e8e\u4e09\u7ef4\u60c5\u51b5 ;\n;;;----------------------------------------------------;\n(defun GEO:Mirror3D (Pt P1 P2 \/ v1 v2 dd P3 P4)\n (if (equal P1 P2 1e-8)\n (GEO:Scale2 P1 Pt)\n (setq v1 (mapcar '- Pt P1)\n v2 (mapcar '- P2 P1)\n dd (MAT:Dot v2 v2)\n P3 (GEO:Scale P2 P1 (\/ (MAT:Dot v1 v2) dd))\n P4 (GEO:Scale2 P3 Pt)\n ) \n ) \n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u955c\u50cf\u70b9\uff08\u53e6\u4e00\u65b9\u6cd5\uff0c\u76f8\u5f53\u4e8e\u7528 Mirror\u547d\u4ee4\u7684\u7ed3\u679c\uff09 ;\n;;;\u8f93\u5165: \u8981\u955c\u50cf\u7684\u70b9Pt\uff0c\u955c\u50cf\u8f74\u7b2c\u4e00\u70b9\u548c\u7b2c\u4e8c\u70b9 ;\n;;;\u8f93\u51fa: \u955c\u50cf\u70b9\u4f4d\u7f6e ;\n;;;----------------------------------------------------;\n(defun GEO:Mirror2D-1 (Pt P1 P2 \/ v p)\n (setq v (mapcar '- p2 p1))\n (setq p (trans (mapcar '- Pt P1) 0 v))\n (setq p (list (- (car p)) (cadr p) (caddr p)))\n (mapcar '+ P1 (trans p v 0))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u8ba1\u7b97\u6709\u9650\u70b9\u96c6\u7684\u8d28\u5fc3 ;\n;;;\u8f93\u5165: \u6709\u9650\u4e2a\u70b9\u96c6 Pts ;\n;;;\u8f93\u51fa: \u8d28\u5fc3\u5750\u6807\uff0c\u7528\u70b9\u8868\u8868\u793a ;\n;;;----------------------------------------------------;\n(defun GEO:Centroid (Pts \/ )\n (MAT:vxs (apply 'mapcar (cons '+ pts)) (\/ 1.0 (length pts)))\n)\n\n;;;----------------------------------------------------;\n;;;\u591a\u4e2a\u7269\u4f53\u7684\u8d28\u5fc3 ;\n;;;\u8f93\u5165: \u622a\u9762\u7684\u8d28\u5fc3\u5217\u8868CenList\u548c\u76f8\u5e94\u7684\u9762\u79ef\u5217\u8868AreaList ;\n;;;\u8f93\u51fa: \u4e00\u4e2a\u6570\u503c\uff0c\u5982\u679c\u4e3a\u6b63\u5219\u662fCCW(\u9006\u65f6\u9488)\uff0c\u5426\u5219\u987a\u65f6\u9488 ;\n;;;----------------------------------------------------;\n(defun GEO:Centroid_Composition (CenList AreaList \/ s)\n (setq S (apply '+ AreaList))\n (if (\/= s 0)\n (list (Mat:vxs (MAT:SxVs CenList AreaList) (\/ 1.0 s)) S)\n )\n)\n\n;;;****************************************************;\n;;;\u76f4\u7ebf\u90e8\u5206 ;\n;;;****************************************************;\n\n;;;----------------------------------------------------;\n;;;\u76f4\u7ebf\u7684\u65b9\u7a0b ;\n;;;Coefficient Equation ;\n;;;\u53c2\u6570: \u4e24\u70b9 ;\n;;;\u8fd4\u56de: \u76f4\u7ebf\u7684\u65b9\u7a0bAx+By+C=0 \u7684\u4e09\u4e2a\u7cfb\u6570A,B,C ;\n;;;----------------------------------------------------;\n(defun LINE:Equation (p1 p2)\n (list\n (- (cadr p1) (cadr p2))\n (- (car p2) (car p1))\n (- (* (car p1) (cadr p2)) (* (cadr p1) (car p2)))\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u76f4\u7ebf\u7684\u65b9\u7a0b1 ;\n;;;\u70b9\u77e2\u91cf\u5f0f\u65b9\u7a0b P0+k*Vector ;\n;;;\u53c2\u6570: \u4e24\u70b9 ;\n;;;\u8fd4\u56de: \u76f4\u7ebf\u7684\u65b9\u7a0b\u7528\u4e00\u70b9\u548c\u76f4\u7ebf\u7684\u65b9\u5411\u77e2\u91cf\u8868\u8fbe ;\n;;;----------------------------------------------------;\n(defun LINE:Equation_1 (p0 p1) \n (list P0 (mapcar '- p1 p0))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u504f\u79fb\u4e00\u6761\u7ebf\u6bb5 ;\n;;;\u8f93\u5165: \u4e24\u70b9\u548c\u4e00\u4e2a\u8ddd\u79bb\uff08\u8d1f\u6570\u4ee3\u8868\u76f4\u7ebf\u6bb5\u7684\u4e0b\u65b9\uff09 ;\n;;;\u8f93\u51fa: \u504f\u79fb\u540e\u7684\u4e24\u70b9 ;\n;;;----------------------------------------------------;\n(defun LINE:Offset (p1 p2 d \/ a)\n (setq a (+ (angle p1 p2) (* pi 0.5)))\n (list (polar p1 a d) (polar p2 a d))\n)\n\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u6c42\u8fc7\u76f4\u7ebf\u5916\u4e00\u70b9\u4f5c\u5df2\u77e5\u89d2\u5ea6\u7684\u7ebf\u4e0e\u5df2\u77e5\u76f4\u7ebf\u7684\u4ea4\u70b9 ;\n;;;\u8f93\u5165: \u4e24\u70b9\u4ee3\u8868\u7684\u76f4\u7ebfMN\u548c\u76f4\u7ebf\u5916\u4e00\u70b9P\u4ee5\u53ca\u5df2\u77e5\u89d2a ;\n;;;\u8f93\u51fa: \u4ea4\u70b9\u6216\u8005nil ;\n;;;----------------------------------------------------;\n(defun LINE:PAMN (p a M N \/)\n (inters P (polar P a 1) M N nil)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9Pt\u5230\u76f4\u7ebfP1P2\u7684\u8ddd\u79bb\uff08\u5e26\u65b9\u5411\uff09 ;\n;;;\u8f93\u5165: \u8981\u6c42\u7684\u70b9Pt\uff0c\u548c\u76f4\u7ebf\u7684\u4e24\u4e2a\u7aef\u70b9P1,P2 ;\n;;;\u8f93\u51fa: \u5e26\u7b26\u53f7\u7684\u8ddd\u79bb\uff0c\u4e3a\u6b63P1,P2,Pt\u9006\u65f6\u9488\uff0c\u5426\u5219\u987a\u65f6\u9488 ;\n;;;----------------------------------------------------;\n(defun LINE:Perpendicular_Distance (pt p1 p2 \/ A B C) \n (setq A (- (cadr p1) (cadr p2)))\n (setq B (- (car p2) (car p1)))\n (setq C (- (* (car p1) (cadr p2)) (* (cadr p1) (car p2))))\n (if (not (and (= A 0) (= b 0)))\n (\/ (+ (* A (car pt)) (* B (cadr pt)) C)\n (sqrt (+ (* A A) (* B B)))\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u5df2\u77e5\u76f4\u7ebf\u65b9\u7a0b\u7cfb\u6570\u6c42\u70b9\u5230\u76f4\u7ebf\u7684\u8ddd\u79bb\uff08\u5e26\u65b9\u5411\uff09 ;\n;;;\u8f93\u5165: \u8981\u6c42\u7684\u70b9Pt\uff0c\u548c\u76f4\u7ebf\u65b9\u7a0b\u7684\u4e09\u4e2a\u7cfb\u6570 ;\n;;;\u8f93\u51fa: \u5e26\u7b26\u53f7\u7684\u8ddd\u79bb\uff0c\u4e3a\u6b63Pt\u5728\u76f4\u7ebf\u65b9\u5411\u7684\u4e0a\u65b9\uff0c\u8d1f\u5219\u53cd\u4e4b;\n;;;----------------------------------------------------;\n(defun LINE:Perpendicular_Distance_1 (Pt A B C \/ AA BB AB k x0 y0 x y D)\n (if (not (and (= a 0) (= b 0)))\n (progn \n (setq AA (* A A))\n (setq BB (* B B))\n (setq AB (* A B))\n (setq k (+ AA BB))\n (setq x0 (car pt))\n (setq y0 (cadr pt))\n \n (setq x (\/ (- (* BB x0) (* AB y0) (* A C)) k))\n (setq y (\/ (- (* AA y0) (* AB x0) (* B C)) k))\n (setq D (\/ (+ (* A x0) (* B y0) C) (sqrt k)))\n (list D (list x y))\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u5230\u76f4\u7ebf\u7684\u8ddd\u79bb\uff08\u5e26\u65b9\u5411\uff09 ;\n;;;\u8f93\u5165: \u8981\u6c42\u7684\u70b9Pt\uff0c\u548c\u76f4\u7ebf\u7684\u4e24\u4e2a\u7aef\u70b9P1,P2 ;\n;;;\u8f93\u51fa: \u5e26\u7b26\u53f7\u7684\u8ddd\u79bb\uff0c\u4e3a\u6b63P1,P2,Pt\u9006\u65f6\u9488\uff0c\u5426\u5219\u987a\u65f6\u9488 ;\n;;;----------------------------------------------------;\n(defun LINE:Perpendicular_Distance_2 (pt p1 p2 \/ )\n (car (trans (mapcar '- pt p1) 0 (mapcar '- p2 p1)))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u5230\u76f4\u7ebf\u7684\u8ddd\u79bb\uff08\u9002\u5408\u4e09\u7ef4\u60c5\u51b5\uff09 ;\n;;;\u8f93\u5165: \u8981\u6c42\u7684\u70b9Pt\uff0c\u548c\u76f4\u7ebf\u7684\u4e24\u4e2a\u7aef\u70b9P1,P2 ;\n;;;\u8f93\u51fa: \u6240\u6c42\u8ddd\u79bb ;\n;;;----------------------------------------------------;\n(defun LINE:Perpendicular_Distance_3 (p0 p1 p2 \/ v0 v1)\n (setq v0 (mapcar '- P0 p1))\n (setq v1 (mapcar '- p2 p1))\n (\/ (MAT:Norm3D (MAT:vxv v0 v1)) (MAT:Norm3D v1))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u5230\u76f4\u7ebf\u7684\u8ddd\u79bb\u548c\u5782\u8db3 ;\n;;;\u8f93\u5165: \u8981\u6c42\u7684\u70b9Pt\uff0c\u548c\u76f4\u7ebf\u7684\u4e24\u4e2a\u7aef\u70b9P1,P2 ;\n;;;\u8f93\u51fa: \u6240\u6c42\u8ddd\u79bb\u548c\u5782\u8db3 ;\n;;;----------------------------------------------------;\n(defun LINE:Perpendicular_Foot (pt p1 p2 \/ d)\n (setq d (LINE:Perpendicular_Distance pt p1 p2))\n (list d (polar pt (- (angle p1 p2) (\/ pi 2)) d))\n)\n\n(defun LINE:Perpendicular_Foot_2 (P p1 p2 \/ pt)\n (setq pt (mapcar '+ (MAT:Rot90 (mapcar '- p1 p2)) p)) \n (inters p1 p2 p pt nil) \n)\n\n(defun LINE:Perpendicular_Foot_3 (p p1 p2 \/ p0) ;???\n (setq p0 (trans (mapcar '- p p1) 0 (mapcar '- p2 p1)))\n (mapcar '+ p1 (list (car p0) (last p0) (cadr p0)))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u5230\u76f4\u7ebf\u7684\u5782\u8db3 ;\n;;;\u8f93\u5165: \u8981\u6c42\u7684\u70b9Pt\uff0c\u548c\u76f4\u7ebf\u7684\u4e24\u4e2a\u7aef\u70b9P1,P2 ;\n;;;\u8f93\u51fa: \u6240\u6c42\u7684\u5782\u8db3 ;\n;;;----------------------------------------------------;\n(defun LINE:Perpendicular_Foot_1 (pt p1 p2)\n (inters pt (mapcar '+ pt (MAT:Rot90 (mapcar '- p1 p2))) p1 p2 nil)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u6c42\u7a7a\u95f4\u4e24\u76f4\u7ebf\u7684\u6700\u77ed\u8ddd\u79bb ;\n;;;\u8f93\u5165: \u4e24\u6761\u76f4\u7ebf\u7684\u56db\u4e2a\u7aef\u70b9P1,P2,P3,P4 ;\n;;;\u8f93\u51fa: \u6240\u6c42\u8ddd\u79bb ;\n;;;----------------------------------------------------;\n(defun LINE:Distance_LineToLine (P1 P2 P3 P4 \/ v1 v2 v3)\n (setq v1 (mapcar '- p2 p1))\n (setq v2 (mapcar '- p4 p3))\n (setq v3 (MAT:vxv v1 v2))\n (\/ (Mat:Dot (mapcar '- P1 P3) v3) (Mat:Norm3D v3))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e24\u6761\u76f4\u7ebf\u6c42\u4ea4\u70b9\u51fd\u6570(\u8ddfinters\u51fd\u6570\u7a0d\u5fae\u6709\u533a\u522b) ;\n;;;\u8f93\u5165: \u4e24\u6761\u76f4\u7ebf\u7684\u56db\u4e2a\u7aef\u70b9P1,P2,P3,P4 ;\n;;;\u8f93\u51fa: nil \u8bf4\u660e\u8fd9\u4e24\u6761\u5e73\u884c\u6216\u8005\u5171\u7ebf\uff0c\u5426\u5219\u8fd4\u56de\u4ea4\u70b9 ;\n;;;----------------------------------------------------;\n(defun LINE:Intersection (p1 p2 p3 p4 \/ DA DB DD X1 X2 X3 X4 Y1 Y2 Y3 Y4)\n (setq x1 (car p1)\n x2 (car p2)\n x3 (car p3)\n x4 (car p4)\n y1 (cadr p1)\n y2 (cadr p2)\n y3 (cadr p3)\n y4 (cadr p4)\n )\n (setq dd (- (* (- x1 x2) (- y3 y4)) (* (- x3 x4) (- y1 y2))))\n (setq da (- (* x1 y2) (* y1 x2)))\n (setq db (- (* x3 y4) (* y3 x4)))\n (if (not (equal dd 0 1e-8))\n (list (\/ (- (* da (- x3 x4)) (* db (- x1 x2))) dd)\n (\/ (- (* da (- y3 y4)) (* db (- y1 y2))) dd)\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e24\u6761\u76f4\u7ebf\u7684\u89d2\u5e73\u5206\u7ebf ;\n;;;\u8f93\u5165: \u4e24\u6761\u76f4\u7ebf\u7684\u56db\u4e2a\u7aef\u70b9P1,P2,P3,P4 ;\n;;;\u8f93\u51fa: \u89d2\u5e73\u5206\u7ebf\u7684\u4e24\u4e2a\u7aef\u70b9 ;\n;;;----------------------------------------------------;\n(defun LINE:Angular_Bisector (p1 p2 p3 p4 \/ an1 an2 an3 an4 int)\n (if (setq int (inters p1 p2 p3 p4 nil))\n (progn\n (setq eps 1e-6)\n (if (equal int p1 eps)\n (setq an1 (angle int p2))\n (setq an1 (angle int p1))\n )\n (if (equal int p3 eps)\n (setq an2 (angle int p4))\n (setq an2 (angle int p3))\n )\n (setq an3 (* (+ an1 an2) 0.5))\n (setq an4 (+ an3 (* 0.5 pi)))\n (list\n (list int (polar int an3 1000))\n (list int (polar int an4 1000))\n )\n )\n (list \n (list\n (Geo:midpoint p1 p3)\n (Geo:midpoint p2 p4)\n )\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u5224\u65ad\u5e73\u9762\u4e0a\u7684\u4e09\u70b9\u662f\u5426\u5171\u7ebf ;\n;;;\u8f93\u5165: \u4e09\u70b9 P1,P2,P3 ;\n;;;\u8f93\u51fa: T \u8bf4\u660e\u4e09\u70b9\u5171\u7ebf\uff0c\u5426\u5219\u4e0d\u5171\u7ebf ;\n;;;----------------------------------------------------;\n(defun LINE:Colinearity (p1 p2 p3 \/ a b c eps)\n (setq eps 1e-6)\n (setq a (distance p2 p3))\n (setq b (distance p3 p1))\n (setq c (distance p1 p2))\n (or (equal (+ a b) c eps)\n (equal (+ b c) a eps)\n (equal (+ c a) b eps)\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u5224\u65ad\u7a7a\u95f4\u4e0a\u4e09\u70b9\u662f\u5426\u5171\u7ebf(\u8ddf\u4e0a\u9762\u7684\u65b9\u6cd5\u6548\u7387\u5dee\u4e0d\u591a);\n;;;\u8f93\u5165: \u4e09\u70b9 P1,P2,P3 ;\n;;;\u8f93\u51fa: T \u8bf4\u660e\u4e09\u70b9\u5171\u7ebf\uff0c\u5426\u5219\u4e0d\u5171\u7ebf ;\n;;;----------------------------------------------------;\n(defun LINE:Colinearity3D (p1 p2 p3 \/ a1 a2)\n (equal (TRI:Det3P p1 p2 p3) 0 1e-8)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u5224\u65ad\u4e24\u70b9\u662f\u5426\u5728\u4e00\u6761\u76f4\u7ebf\u7684\u540c\u4e00\u4fa7 ;\n;;;\u8f93\u5165: \u8981\u5224\u65ad\u7684\u4e24\u70b9\u70b9P1,P2\u548c\u76f4\u7ebf\u7684\u4e24\u4e2a\u7aef\u70b9Pa,Pb ;\n;;;\u8f93\u51fa: T \u8bf4\u660e\u540c\u4fa7\uff0cnil\u5f02\u4fa7 ;\n;;;----------------------------------------------------;\n(defun LINE:IsSameSide (P1 P2 Pa Pb \/ d1 d2 eps)\n (setq eps 1e-6)\n (setq d1 (TRI:Det3P P1 PA PB))\n (setq d2 (TRI:Det3P P2 PA PB))\n (or (and (<= d1 eps) (<= d2 eps))\n (and (>= d1 (- eps)) (>= d2 (- eps)))\n )\n)\n\n;;;****************************************************;\n;;;\u7a7a\u95f4\u5e73\u9762\u90e8\u5206 ;\n;;;****************************************************;\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u6cd5\u7ebf\u7684\u5e73\u9762\u65b9\u7a0b ;\n;;;\u8f93\u5165: P0\u5e73\u9762\u4e0a\u7684\u4e00\u70b9\uff0cN\u5e73\u9762\u7684\u6cd5\u7ebf\u77e2\u91cf ;\n;;;\u8f93\u51fa: \u5e73\u9762\u65b9\u7a0b\u7684\u7cfb\u6570\u5217\u8868 ;\n;;;----------------------------------------------------;\n(defun PLANE:Equation (P0 N)\n (append N (list (- (MAT:Dot P0 N))))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e09\u70b9\u5f0f\u5e73\u9762\u65b9\u7a0b ;\n;;;\u8f93\u5165: \u5e73\u9762\u4e0a\u7684\u4e09\u70b9 ;\n;;;\u8f93\u51fa: \u5e73\u9762\u65b9\u7a0b\u7684\u7cfb\u6570\u5217\u8868 ;\n;;;----------------------------------------------------;\n(defun PLANE:Equation_3P (P0 P1 P2 \/ v1 v2 N)\n (setq v1 (mapcar '- p1 p0))\n (setq v2 (mapcar '- P2 p0))\n (setq N (MAT:vxv v1 v2))\n (PLANE:Equation P0 N)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u5230\u5e73\u9762\u7684\u8ddd\u79bb\uff08\u6709\u5411\u7684\u8ddd\u79bb\uff09 ;\n;;;\u8f93\u5165: \u4e00\u70b9P\u548c\u5e73\u9762\u7684\u65b9\u7a0b\u4e3aAx+By+Cz+D=0\u7684\u56db\u4e2a\u7cfb\u6570 ;\n;;;\u8f93\u51fa: \u8be5\u70b9\u5230\u5e73\u9762\u7684\u8ddd\u79bb ;\n;;;----------------------------------------------------;\n(defun PLANE:Distance (P A B C D)\n (if (and (zerop A) (zerop B) (zerop C))\n nil\n (\/ (+ (* A (car P)) (* B (cadr P)) (* C (caddr P)) D)\n (distance '(0 0 0) (list A B C))\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u5230\u4e09\u70b9\u51b3\u5b9a\u7684\u5e73\u9762\u7684\u8ddd\u79bb\uff08\u6709\u5411\u7684\u8ddd\u79bb\uff09 ;\n;;;\u8f93\u5165: \u4e00\u70b9P\u548c\u5e73\u9762\u7684\u65b9\u7a0b\u4e3aAx+By+Cz+D=0\u7684\u56db\u4e2a\u7cfb\u6570 ;\n;;;\u8f93\u51fa: \u8be5\u70b9\u5230\u5e73\u9762\u7684\u8ddd\u79bb ;\n;;;----------------------------------------------------;\n(defun PLANE:Distance_1 (P p1 p2 p3 \/) \n (Apply 'PLANE:Distance (cons p (PLANE:Equation_3P p1 p2 p3)))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u5230\u4e09\u70b9\u51b3\u5b9a\u7684\u5e73\u9762\u7684\u8ddd\u79bb\u548c\u8be5\u70b9\u5728\u5e73\u9762\u4e0a\u7684\u6295\u5f71\u70b9;\n;;;\u8f93\u5165: \u4e00\u70b9P\u548c\u4e09\u70b9P1,P2,P3\u51b3\u5b9a\u7684\u5e73\u9762 ;\n;;;\u8f93\u51fa: \u8be5\u70b9\u5230\u5e73\u9762\u7684\u5782\u8db3 ;\n;;;----------------------------------------------------;\n(defun PLANE:Perpendicular_Foot_1 (P p1 p2 p3 \/ F A B C D H N L)\n (setq F (PLANE:Equation_3P p1 p2 p3))\n (setq A (car f)\n B (cadr f)\n C (caddr f)\n D (last f)\n )\n (setq H (PLANE:Distance p A B C D))\n (setq N (List A B C))\n (setq L (distance '(0 0 0) N)) \n (if (not (zerop L)) \n (list H (Geo:scale (mapcar '+ p N) P (- (\/ H L))))\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u70b9\u5230\u4e09\u70b9\u51b3\u5b9a\u7684\u5e73\u9762\u7684\u8ddd\u79bb\u548c\u8be5\u70b9\u5728\u5e73\u9762\u4e0a\u7684\u6295\u5f71\u70b9;\n;;;\u8f93\u5165: \u4e00\u70b9P\u548c\u901a\u8fc7P0\u6cd5\u7ebf\u77e2\u91cf\u4e3aNormal\u51b3\u5b9a\u7684\u5e73\u9762 ;\n;;;\u8f93\u51fa: \u8be5\u70b9\u5230\u5e73\u9762\u7684\u5782\u8db3 ;\n;;;----------------------------------------------------;\n(defun PLANE:Perpendicular_Foot (P P0 Normal \/ l d)\n (setq l (distance '(0 0 0) Normal))\n (setq d (caddr (trans (mapcar '- p p0) 0 Normal T)))\n (mapcar '- P (mat:vxs Normal (\/ d l)))\n)\n\n(defun PLANE:Perpendicular_Foot_2 (P P0 Normal \/ l d)\n (setq l (distance '(0 0 0) Normal))\n (setq l (* l l))\n (setq d (mat:dot Normal (mapcar '- p p0)))\n (mapcar '- P (mat:vxs Normal (\/ d l)))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u6c42\u7a7a\u95f4\u76f4\u7ebf\u4e0e\u5e73\u9762\u7684\u4ea4\u70b9 ;\n;;;\u8f93\u5165: \u51b3\u5b9a\u76f4\u7ebf\u7684\u4e24\u70b9Pa,Pb\u548c\u4e09\u70b9P1,P2,P3\u51b3\u5b9a\u7684\u5e73\u9762 ;\n;;;\u8f93\u51fa: \u8be5\u70b9\u5230\u5e73\u9762\u7684\u8ddd\u79bb ;\n;;;----------------------------------------------------;\n(defun PLANE:Line_Inters_Plane (Pa Pb A B C D \/ h1 h2)\n (setq h1 (Plane:Distance Pa A b c d))\n (setq h2 (plane:distance Pb a b c d))\n (if (and h1 h2)\n (cond\n ( (equal h1 0 1e-14) Pa)\n ( (equal h2 0 1e-14) Pb)\n (t (GEO:Proportion Pa Pb (- (\/ h1 h2))))\n )\n )\n)\n\n;;;****************************************************;\n;;;\u4e09\u89d2\u5f62\u90e8\u5206 ;\n;;;****************************************************;\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u5224\u65ad\u662f\u5426\u6784\u6210\u4e09\u89d2\u5f62 ;\n;;;\u8f93\u5165: \u4e09\u8fb9\u7684\u957f\u5ea6a,b,c ;\n;;;\u8f93\u51fa: \u6784\u6210\u4e09\u89d2\u5f62\u5219\u8fd4\u56deT\uff0c\u5426\u5219\u8fd4\u56denil ;\n;;;----------------------------------------------------;\n(defun TRI:IsTriangle (a b c \/)\n (and (> (+ a b) c) (> (+ b c) a) (> (+ c a) b))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u6c42\u4e09\u89d2\u5f62\u5916\u5fc3 TRI:CircumCenter\uff0cExCenter ;\n;;;\u8f93\u5165: \u7ed9\u5b9a\u4e0d\u5171\u7ebf\u7684\u4e09\u4e2a\u70b9 ;\n;;;\u8f93\u51fa: \u8fd9\u4e09\u70b9\u7684\u5916\u63a5\u5706\u7684\u5706\u5fc3\u548c\u534a\u5f84 ;\n;;;\u8bf4\u660e: \u5c3d\u7ba1\u8fd9\u6837\u5199\u5f88\u9ebb\u70e6\uff0c\u663e\u5f97\u4ee3\u7801\u5f88\u591a\uff0c\u4f46\u8fd0\u884c\u5374\u5f88\u5feb ;\n;;;----------------------------------------------------;\n(defun TRI:CircumCenter (P0 P1 P2 \/ X0 Y0 X1 Y1 X2 Y2 DX1 DY1 DX2 DY2 D 2D C1 C2 CE)\n (setq X0 (car P0)\n Y0 (cadr P0)\n X1 (car P1)\n Y1 (cadr P1)\n X2 (car P2)\n Y2 (cadr P2)\n DX1 (- X1 X0)\n DY1 (- Y1 Y0)\n DX2 (- X2 X0)\n DY2 (- Y2 Y0)\n )\n (setq D (- (* DX1 DY2) (* DX2 DY1)))\n (if (equal D 0 1e-14)\n nil\n (progn\n (setq 2D (+ D D)\n C1 (+ (* DX1 (+ X0 X1)) (* DY1 (+ Y0 Y1)))\n C2 (+ (* DX2 (+ X0 X2)) (* DY2 (+ Y0 Y2)))\n CE (List (\/ (- (* C1 DY2) (* C2 DY1)) 2D)\n (\/ (- (* C2 DX1) (* C1 DX2)) 2D)\n )\n )\n (list CE (distance CE P0))\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e09\u89d2\u5f62\u5185\u5fc3 ;\n;;;\u516c\u5f0f: (aX1+bx2+cx3)\/(a+b+c),(aY2+bY2+CY3)\/(a+b+c) ;\n;;;\u8f93\u5165: \u7ed9\u5b9a\u4e0d\u5171\u7ebf\u7684\u4e09\u4e2a\u70b9 ;\n;;;\u8f93\u51fa: \u8fd9\u4e09\u70b9\u7684\u5185\u5207\u5706\u7684\u5706\u5fc3\u548c\u534a\u5f84 ;\n;;;----------------------------------------------------;\n(defun TRI:InCenter (pa pb pc \/ a b c L I r)\n (setq a (distance pb pc))\n (setq b (distance pc pa))\n (setq c (distance pa pb))\n (setq L (+ a b c))\n (if (\/= L 0.0)\n (setq I (MAT:SxVs (list pa pb pc) (list (\/ a L) (\/ b L) (\/ c L)))\n R (list I (abs (LINE:Perpendicular_Distance I pa pb)))\n )\n (list pa 0)\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e09\u89d2\u5f62\u5782\u5fc3 ;\n;;;\u8f93\u5165: \u7ed9\u5b9a\u4e0d\u5171\u7ebf\u7684\u4e09\u4e2a\u70b9 ;\n;;;\u8f93\u51fa: \u8fd9\u4e2a\u4e09\u70b9\u5f62\u6210\u7684\u4e09\u89d2\u5f62\u7684\u5782\u5fc3 ;\n;;;----------------------------------------------------;\n(defun TRI:OrthoCenter (pa pb pc \/ p1 p2)\n (setq p1 (GEO:Rot90 Pa pb pc))\n (setq p2 (GEO:Rot90 pb pc pa))\n (inters pa p1 pb p2 nil)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e09\u89d2\u5f62\u91cd\u5fc3 ;\n;;;\u8f93\u5165: \u7ed9\u5b9a\u4e0d\u5171\u7ebf\u7684\u4e09\u4e2a\u70b9 ;\n;;;\u8f93\u51fa: \u8fd9\u4e2a\u4e09\u70b9\u5f62\u6210\u7684\u4e09\u89d2\u5f62\u7684\u91cd\u5fc3 ;\n;;;----------------------------------------------------;\n(defun TRI:Barycenter (p1 p2 p3)\n (mapcar (function (lambda (e1 e2 e3) (\/ (+ e1 e2 e3) 3.0))) p1 p2 p3)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u4e09\u89d2\u5f62\u7684\u4e5d\u70b9\u5706 ;\n;;;\u8f93\u5165: \u7ed9\u5b9a\u4e0d\u5171\u7ebf\u7684\u4e09\u4e2a\u70b9 ;\n;;;\u8f93\u51fa: \u8fd9\u4e2a\u4e09\u70b9\u5f62\u6210\u7684\u4e09\u89d2\u5f62\u7684\u4e5d\u70b9\u5706\u7684\u5706\u5fc3\u548c\u534a\u5f84 ;\n;;;----------------------------------------------------;\n(defun TRI:9P_Circle (pa pb pc)\n (apply 'TRI:CircumCenter\n (mapcar 'GEO:Midpoint (list pa pb pc) (list pb pc pa))\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u4e09\u7ebf\u5750\u6807\u8f6c\u5316\u4e3a\u4e16\u754c\u5750\u6807 k = 2S\/(ax+by+cz) ;\n;;;\u6ce8\u610f: \u4e09\u7ebf\u5750\u6807\u8ddf\u7b1b\u5361\u5c14\u5750\u6807\u7684\u8868\u793a\u4e0a\u7684\u4e0d\u540c ;\n;;;\u8f93\u5165: \u4e09\u7ebf\u5750\u6807P(list x y z)=>x:y:z\u548c\u5bf9\u5e94\u4e09\u70b9Pa,Pb,Pc;\n;;;\u8f93\u51fa: \u8fd4\u56de\u4e16\u754c\u5750\u6807\u7cfb\u7684\u70b9 ;\n;;;----------------------------------------------------;\n(defun TRI:TCS->WCS (P Pa Pb Pc \/ x y z V1 V2 V3 p1 p2 p3 int)\n (setq V1 (LINE:Offset Pb Pc (car P)))\n (setq V2 (LINE:Offset Pc Pa (cadr p)))\n (setq V3 (LINE:Offset Pa Pb (caddr p)))\n (setq p1 (inters (car V2) (cadr V2) (car V3) (cadr V3) nil))\n (setq p2 (inters (car V3) (cadr V3) (car V1) (cadr V1) nil))\n (setq p3 (inters (car V1) (cadr V1) (car V2) (cadr V2) nil))\n (if (setq int (inters Pa P1 Pb P2 nil))\n int\n (if (setq int (inters Pb P2 Pc P3 nil))\n int\n (inters Pc P3 Pa P1 nil)\n )\n )\n)\n \n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u76f8\u4f3c\u91cd\u5fc3,Lemoine Point ,or symmedian point ;\n;;;\u8f93\u5165: \u7ed9\u5b9a\u4e0d\u5171\u7ebf\u7684\u4e09\u4e2a\u70b9 ;\n;;;\u8f93\u51fa: \u8fd9\u4e2a\u4e09\u70b9\u5f62\u6210\u7684\u4e09\u89d2\u5f62\u7684\u76f8\u4f3c\u91cd\u5fc3 ;\n;;;----------------------------------------------------;\n(defun TRI:Symmedian_Point (Pa Pb Pc \/ a b c)\n (setq a (distance Pb Pc))\n (setq b (distance pc Pa))\n (setq c (distance Pa Pb))\n (TRI:TCS->WCS (list a b c) Pa Pb Pc)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u67d0\u70b9\u5bf9\u7ed9\u5b9a\u4e09\u89d2\u5f62\u7684\u7b49\u89d2\u5171\u8f6d\u70b9 ;\n;;;\u8f93\u5165: \u4e00\u70b9Pt \u548c\u6784\u6210\u4e09\u89d2\u5f62\u7684\u4e09\u70b9Pa Pb Pc ;\n;;;\u8f93\u51fa: \u8fd9\u70b9\u5bf9\u7ed9\u5b9a\u4e09\u89d2\u5f62\u7684\u7b49\u89d2\u5171\u8f6d\u70b9 ;\n;;;----------------------------------------------------;\n(defun TRI:Isogonal-Conjugate-Point (Pt Pa Pb Pc \/ Pt1 Pt2 Inc)\n (setq InC (car (TRI:InCenter Pa Pb Pc)))\n (setq Pt1 (GEO:Mirror3D Pt Pa Inc))\n (setq pt2 (GEO:Mirror3D Pt Pb Inc))\n (inters Pa Pt1 Pb Pt2 nil)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u67d0\u70b9\u5bf9\u7ed9\u5b9a\u4e09\u89d2\u5f62\u7684\u7b49\u89d2\u5171\u8f6d\u70b9 ;\n;;;\u8f93\u5165: \u4e00\u70b9Pt \u548c\u6784\u6210\u4e09\u89d2\u5f62\u7684\u4e09\u70b9Pa Pb Pc ;\n;;;\u8f93\u51fa: \u8fd9\u70b9\u5bf9\u7ed9\u5b9a\u4e09\u89d2\u5f62\u7684\u7b49\u89d2\u5171\u8f6d\u70b9 ;\n;;;\u8bf4\u660e: \u5982\u679c\u5df2\u77e5\u4e09\u89d2\u5f62\u5185\u5fc3\uff0c\u5219\u53ef\u4ee5\u7b80\u7565\u8ba1\u7b97 ;\n;;;----------------------------------------------------;\n(defun TRI:Isogonal-Conjugate-Point-1 (Pt Pa Pb Inc \/)\n (inters Pa (GEO:Mirror3D Pt Pa Inc) Pb (GEO:Mirror3D Pt Pb Inc) nil)\n)\n\n;;;----------------------------------------------------;\n;;;\u6839\u636e\u4e09\u89d2\u5f62\u7684\u4e09\u8fb9\u957f\u83b7\u53d6\u4e09\u89d2\u5f62\u4fe1\u606f ;\n;;;\u8f93\u5165: \u4e09\u8fb9\u7684\u8fb9\u957fa,b,c ;\n;;;\u8f93\u51fa: \u4e09\u89d2\u5f62\u7684\u4e09\u4e2a\u89d2\u5ea6\uff0c\u9762\u79ef\u548c\u5468\u957f\uff0c\u5185\u5fc3\u548c\u5185\u5207\u5706\u534a\u5f84;\n;;; \u65c1\u5207\u5706\u7684\u5706\u5fc3\u548c\u534a\u5f84\uff0c\u5916\u5fc3\u548c\u5916\u63a5\u5706\u534a\u5f84\uff0c\u5782\u5fc3\uff0c ;\n;;; \u91cd\u5fc3\uff0c\u7c7b\u4f3c\u91cd\u5fc3\uff0c\u7b49\u5468\u5fc3\u4ee5\u53ca\u4e5d\u70b9\u5706\u5706\u5fc3 ;\n;;;----------------------------------------------------;\n;|\nhttp:\/\/en.wikipedia.org\/wiki\/Trilinear_coordinates \nwhere a, b, c are the respective sidelengths BC, CA, AB,\nand \u03c3 = area of ABC. \nA = 1 : 0 : 0 \nB = 0 : 1 : 0 \nC = 0 : 0 : 1 \nincenter = 1 : 1 : 1 \ncentroid = bc:ca:ab = 1\/a:1\/b:1\/c = cscA : cscB : cscC. \ncircumcenter = cos A : cos B : cos C. \northocenter = sec A : sec B : sec C. \nnine-point center = cos(B - C) : cos(C - A) : cos(A - B)\nsymmedian point = a : b : c = sin A : sin B : sin C. \nA-excenter = -1 : 1 : 1 \nB-excenter = 1 : -1 : 1 \nC-excenter = 1 : 1 : -1. \n;;;de Longchamps point \n;;;http:\/\/en.wikipedia.org\/wiki\/De_Longchamps_point \n;;;symmedian point \n;;;http:\/\/en.wikipedia.org\/wiki\/Symmedian_point \nhttp:\/\/mathworld.wolfram.com\/TriangleCenter.html \n|; \n(defun TRI:InfoBy3Sides (a b c \/ p S 2S Aa Ab Ac D K Ri Re Ra Rb Rc Ca Cb Cc Sa Sb Sc)\n (setq p (* 0.5 (+ a b c))) ;\u534a\u5468\u957f\n (setq S (sqrt (* p (- p a) (- p b) (- p c)))) ;\u9762\u79ef\n (setq Ri (\/ S p)) ;\u5185\u5207\u5706\u534a\u5f84\n (setq K (* 2 Ri p))\n (setq Ra (\/ k (+ b c (- a)))) ;\u8fb9A\u65c1\u5207\u5706\u534a\u5f84\n (setq Rb (\/ k (+ c a (- b)))) ;\u8fb9B\u65c1\u5207\u5706\u534a\u5f84\n (setq Rc (\/ k (+ a b (- c)))) ;\u8fb9C\u65c1\u5207\u5706\u534a\u5f84\n (setq Re (\/ (* a b c 0.25) S)) ;\u5916\u63a5\u5706\u534a\u5f84\n (setq D (+ Re Re)) ;\u5916\u63a5\u5706\u76f4\u5f84\n (setq Ca (\/ (+ (* b b) (* (+ c a) (- c a))) 2 b c)) ;\u89d2A\u4f59\u5f26\n (setq Cb (\/ (+ (* c c) (* (+ a b) (- a b))) 2 c a)) ;\u89d2B\u4f59\u5f26\n (setq Cc (\/ (+ (* a a) (* (+ b c) (- b c))) 2 a b)) ;\u89d2C\u4f59\u5f26\n (setq Sa (\/ a D)) ;\u89d2A\u6b63\u5f26\n (setq Sb (\/ b D)) ;\u89d2B\u6b63\u5f26\n (setq Sc (\/ c D)) ;\u89d2C\u6b63\u5f26\n (setq Aa (atan Sa Ca)) ;\u89d2A\n (setq Ab (atan Sb Cb)) ;\u89d2B\n (Setq Ac (atan Sc Cc)) ;\u89d2C\n (setq 2S (+ S S))\n (list (list Aa Ab Ac) ;\u4e09\u4e2a\u89d2\n (list S (+ p p)) ;\u9762\u79ef\u548c\u5468\u957f\n (list '( 1 1 1) Ri) ;\u5185\u5fc3\n (list '(-1 1 1) Ra) ;\u8fb9A\u65c1\u5207\u5706\u534a\u5f84\n (list '( 1 -1 1) Rb) ;\u8fb9B\u65c1\u5207\u5706\u534a\u5f84\n (list '( 1 1 -1) Rc) ;\u8fb9C\u65c1\u5207\u5706\u534a\u5f84\n (list (list Ca Cb Cc) Re) ;\u5916\u5fc3\n (list (list (\/ 1 Ca) (\/ 1 Cb) (\/ 1 Cc))) ;\u5782\u5fc3\n (list (list (\/ 1 a) (\/ 1 b) (\/ 1 c))) ;\u91cd\u5fc3\n (list (list a b c)) ;\u7c7b\u4f3c\u91cd\u5fc3\n (list (list (cos (- Ab Ac))\n (cos (- Ac Aa))\n (cos (- Aa Ab))\n ) ;\u4e5d\u70b9\u5706\u5706\u5fc3\n (* 0.5 Re) ;\u4e5d\u70b9\u5706\u534a\u5f84\n )\n (list (list (1- (\/ 2S a (+ b c (- a)))) \n (1- (\/ 2S b (+ c a (- b))))\n (1- (\/ 2S c (+ a b (- c))))\n )\n ) ;\u7b49\u5468\u70b9(Isoperimetric Point)\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u5b9a\u4e49\u4e09\u70b9\u7684\u884c\u5217\u5f0f,\u5373\u4e09\u70b9\u4e4b\u500d\u9762\u79ef ;\n;;;\u8f93\u5165: \u4e09\u70b9P1,P2,P3 ;\n;;;\u8f93\u51fa: \u8fd9\u4e09\u70b9\u5f62\u6210\u7684\u4e09\u89d2\u5f62\u7684\u9762\u79ef\u76842\u500d\uff0c\u7b26\u53f7\u6307\u793a\u65b9\u5411\u3002 ;\n;;;----------------------------------------------------;\n(defun TRI:Det3P (p1 p2 p3)\n (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))\n (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u7528\u6d77\u4f26\u516c\u5f0f(Heron's formula)\u6c42\u4e09\u89d2\u5f62\u9762\u79ef ;\n;;;\u8f93\u5165: \u4e09\u89d2\u5f62\u7684\u4e09\u4e2a\u8fb9\u957fa,b,c ;\n;;;\u8f93\u51fa: \u4e09\u89d2\u5f62\u9762\u79ef ;\n;;;----------------------------------------------------;\n(defun TRI:Area (a b c \/ p)\n (setq p (* 0.5 (+ a b c)))\n (sqrt (* p (- p a) (- p b) (- p c)))\n)\n\n\n;;;----------------------------------------------------;\n;;; \u529f\u80fd: \u6839\u636e\u4e09\u8fb9\u6c42\u4e09\u4e2a\u89d2(\u5229\u7528\u4f59\u5f26\u5b9a\u7406) ;\n;;; \u8f93\u5165: \u6784\u6210\u4e09\u89d2\u5f62\u7684\u4e09\u8fb9a,b,c ;\n;;; \u8f93\u51fa: \u8fd4\u4f1a\u4e09\u6761\u8fb9\u5bf9\u5e94\u7684\u4e09\u4e2a\u89d2 ;\n;;;----------------------------------------------------;\n(defun TRI:CosinesLaw (a b c \/ cc sc a1 a2)\n (if (TRI:IsTriangle a b c)\n (progn\n (setq a (float a)) ;\u4e3a\u4e86\u9632\u6b62\u6574\u9664\n (setq cc (\/ (+ (* a a) (* (+ b c) (- b c))) (+ a a) b)) ;\u89d2C\u7684\u4f59\u5f26\n (setq sc (sqrt (* (- 1 cc) (1+ cc)))) ;\u89d2C\u7684\u6b63\u5f26\n (setq a1 (atan (* a sc) (- b (* a cc)))) ;\u89d2A\n (setq a2 (atan sc cc)) ;\u89d2C\n (list a1 (- pi a1 a2) a2) ;\u8fd4\u56de\u4e09\u4e2a\u89d2\u5ea6\u7684\u5217\u8868\n )\n )\n)\n\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u8ba1\u7b97\u5df2\u77e5\u7a7a\u95f4\u4e09\u70b9\u7684\u4e09\u89d2\u5f62\u9762\u79ef ;\n;;;\u8f93\u5165: \u7a7a\u95f4\u4e09\u70b9 P1,P2,P3 ;\n;;;\u8f93\u51fa: \u4e09\u89d2\u5f62\u9762\u79ef ;\n;;;----------------------------------------------------;\n(defun TRI:Area3D (p1 p2 p3 \/ v1 v2 d1 d2 d3)\n (setq v1 (mapcar '- p2 p1))\n (setq v2 (mapcar '- p3 p1))\n (setq d1 (MAT:Det2 (car v1) (cadr v1) (car v2) (cadr v2)))\n (setq d2 (MAT:Det2 (cadr v1) (caddr v1) (cadr v2) (caddr v2)))\n (setq d3 (MAT:Det2 (caddr v1) (car v1) (caddr v2) (car v2)))\n (* 0.5 (sqrt (+ (* d1 d1) (* d2 d2) (* d3 d3))))\n)\n\n;;;****************************************************;\n;;;\u591a\u8fb9\u5f62\u90e8\u5206 ;\n;;;****************************************************;\n\n(defun POLY:IsInside (p Pts)\n (setq ans (mapcar (function (lambda (x) (angle p x))) pts))\n (mapcar '+ ans)\n)\n\n(defun c:ppp ()\n (initget 1)\n (setq p (getpoint \"n\u70b9:\"))\n (setq sel (ssget \":S\" '((0 . \"*POLYLINE\"))))\n (if (and p sel)\n (progn\n (setq ent (ssname sel 0))\n (setq num (vlax-curve-getEndParam ent))\n (setq i 0)\n (repeat (fix num)\n (setq pt (vlax-curve-getPointAtParam ent i))\n (setq pts (cons pt pts))\n (setq i (1+ i))\n )\n (setq pts (reverse pts))\n (setq ret (POLY:IsInside p pts))\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u8ba1\u7b97\u591a\u8fb9\u5f62\u9762\u79ef(\u4e3a\u7b80\u5355\u591a\u8fb9\u5f62\uff0c\u4e0d\u81ea\u4ea4\u7684\u591a\u8fb9\u5f62) ;\n;;;\u8f93\u5165: \u591a\u8fb9\u5f62\u9876\u70b9\u5217\u8868 Pts ;\n;;;\u8f93\u51fa: \u4e00\u4e2a\u6570\u503c\uff0c\u5982\u679c\u4e3a\u6b63\u5219\u662fCCW(\u9006\u65f6\u9488)\uff0c\u5426\u5219\u987a\u65f6\u9488 ;\n;;;\u53c2\u8003: Centroid Shoelace formula ;\n;;;----------------------------------------------------;\n(defun POLY:Area (pts)\n (* (apply '+ (mapcar 'MAT:Det2V pts (MISC:1st->Last Pts))) 0.5)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u8ba1\u7b97\u591a\u8fb9\u5f62\u5468\u957f ;\n;;;\u8f93\u5165: \u591a\u8fb9\u5f62\u9876\u70b9\u5217\u8868 Pts ;\n;;;\u8f93\u51fa: \u4e00\u4e2a\u6570\u503c\uff0c\u8868\u793a\u591a\u8fb9\u5f62\u5468\u957f ;\n;;;----------------------------------------------------;\n(defun POLY:Perimeter (pts)\n (apply '+ (mapcar 'distance pts (MISC:1st->Last Pts)))\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u5224\u65ad\u591a\u8fb9\u5f62\u7684\u65b9\u5411(\u4e3a\u7b80\u5355\u591a\u8fb9\u5f62\uff0c\u4e0d\u81ea\u4ea4\u7684\u591a\u8fb9\u5f62);\n;;;\u8f93\u5165: \u591a\u8fb9\u5f62\u9876\u70b9\u5217\u8868 Pts ;\n;;;\u8f93\u51fa: \u8fd4\u56deT\u5219\u662fCCW(\u9006\u65f6\u9488)\uff0c\u5426\u5219\u987a\u65f6\u9488 ;\n;;;----------------------------------------------------;\n(defun POLY:IsCCW (Pts)\n (> (POLY:Area pts) 0.0)\n)\n\n;;;----------------------------------------------------;\n;;;\u529f\u80fd: \u83b7\u53d6\u591a\u8fb9\u5f62\u4fe1\u606f(\u8d28\u5fc3\uff0c\u9762\u79ef\uff0c\u5468\u957f) ;\n;;;\u8f93\u5165: Pts---\u591a\u8fb9\u5f62\u9876\u70b9\u5217\u8868 ;\n;;;\u8f93\u51fa: \u5217\u8868:\u7b2c\u4e00\u4e2a\u4e3a\u591a\u8fb9\u5f62\u7684\u9762\u79ef\u4e2d\u5fc3(\u8d28\u5fc3),\u75282d\u70b9\u8868\u793a;\n;;; \u7b2c\u4e8c\u4e2a\u4e3a\u6570\u503c\uff0c\u6b63\u6570\u8868\u793a\u591a\u8fb9\u5f62\u65b9\u5411\u662fCCW(\u9006\u65f6\u9488) ;\n;;; \u8d1f\u6570\u8868\u793a\u987a\u65f6\u9488\uff1b\u7b2c\u4e09\u4e2a\u4e3a\u5468\u957f. ;\n;;;\u53c2\u8003: http:\/\/en.wikipedia.org\/wiki\/Centroid ;\n;;;----------------------------------------------------;\n(defun POLY:Infomation (Pts \/ Pts1 Ai S lst cen)\n (setq Pts1 (MISC:1st->Last Pts)) ;another point of every side\n (setq Ai (mapcar 'MAT:Det2V Pts Pts1)) ;area of every side \n (setq S (* (apply '+ Ai) 0.5)) ;Total area\n (Setq Cen (MAT:SxVs (mapcar 'MAT:v+v Pts Pts1) Ai))\n (setq Cen (MAT:vxs Cen (\/ 0.166666666666666667 S))) ;base on the formula\n (list Cen S (apply '+ (mapcar 'distance pts pts1))) ;Return Centroid,Total area and Perimeter\n)\n\n;;;----------------------------------------------------;\n;;;Circular segment ;\n;;;\u5f13\u7684\u8d28\u5fc3\u6c42\u4ee5\u53ca\u5f13\u5f62\u7684\u9762\u79ef ;\n;;;\u8f93\u5165: C---\u5706\u5fc3;Center ;\n;;; R---\u534a\u5f84;Radius ;\n;;; A1--\u8d77\u59cb\u89d2;0 <= A1 <= 2*Pi Start Angle(Radian);\n;;; A2--\u7ec8\u6b62\u89d2;0 <= A2 <= 2*Pi End Angle(Radian) ;\n;;; IsCW--\u662f\u5426\u987a\u65f6\u9488 ;\n;;;\u8f93\u51fa: \u5217\u8868: \u7b2c\u4e00\u9879\u4e3a\u8d28\u5fc3\uff0c\u7b2c\u4e8c\u9879\u4e3a\u9762\u79ef\uff0c\u7b2c\u4e09\u9879\u4e3a\u5f27\u957f;\n;;;----------------------------------------------------;\n(defun CIR:Circular_Segment (C R A1 A2 IsCW \/ A k d S e)\n (and isCW (setq A A2 A2 A1 A1 A))\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 R k k k))\n (setq e (- A (sin A)))\n (setq S (* 0.5 R R e))\n (and IsCW (setq S (- S))) ;\u5982\u679c\u987a\u65f6\u9488\uff0c\u9762\u79ef\u4e3a\u8d1f\n (setq d (\/ k e))\n (if (> A1 A2) (setq d (- d))) ;\u8fd9\u79cd\u60c5\u51b5\u4e0b\u8981\u53cd\u5411\n (list (polar C (* 0.5 (+ A1 A2)) d) S (* A R))\n)\n\n;;;----------------------------------------------------;\n;;;Circular sector ;\n;;;\u6247\u5f62\u7684\u8d28\u5fc3\uff0c\u9762\u79ef\u548c\u5468\u957f ;\n;;;\u8f93\u5165: C---\u5706\u5fc3;Center ;\n;;; R---\u534a\u5f84;Radius ;\n;;; A1--\u8d77\u59cb\u89d2;0 <= A1 <= 2*Pi Start Angle(Radian);\n;;; A2--\u7ec8\u6b62\u89d2;0 <= A2 <= 2*Pi End Angle(Radian) ;\n;;; IsCW--\u662f\u5426\u987a\u65f6\u9488 ;\n;;;\u8f93\u51fa: \u5217\u8868: \u7b2c\u4e00\u9879\u4e3a\u8d28\u5fc3\uff0c\u7b2c\u4e8c\u9879\u4e3a\u9762\u79ef\uff0c\u7b2c\u4e09\u9879\u4e3a\u5468\u957f;\n;;;----------------------------------------------------;\n(defun CIR:Circular_Sector (C R A1 A2 IsCW \/ A d S L)\n (and IsCW (setq A A2 A2 A1 A1 A))\n (if (> A1 A2)\n (setq A (- (+ pi pi A2) A1))\n (setq A (- A2 A1))\n )\n (setq d (\/ (* 4 R (sin (* 0.5 A))) 3 A))\n (setq S (* 0.5 A R R)) \n (and IsCW (setq S (- S))) ;\u5982\u679c\u987a\u65f6\u9488\uff0c\u9762\u79ef\u4e3a\u8d1f\n (setq L (* R (+ A 2))) ;\u5468\u957f\n (if (> A1 A2) (setq d (- d))) ;\u8fd9\u79cd\u60c5\u51b5\u4e0b\u8981\u53cd\u5411\n (list (polar C (* 0.5 (+ A1 A2)) d) S L)\n)\n\n;;;----------------------------------------------------;\n;;;\u83b7\u5f97\u8f7b\u591a\u6bb5\u7ebf\u7684\u6709\u5f27\u6bb5\u5904\u7684\u9876\u70b9\u7684\u4fe1\u606f ;\n;;;\u8f93\u5165: P1---\u9876\u70b9\u5750\u6807(OCS) ;\n;;; P2---\u4e0b\u4e00\u9876\u70b9\u5750\u6807(OCS) ;\n;;; b----\u51f8\u5ea6\uff08\u4e0d\u4e3a\u96f6\uff09 ;\n;;;\u8f93\u51fa: \u5217\u8868: \u7b2c\u4e00\u9879\u4e3a\u8d28\u5fc3\uff0c\u7b2c\u4e8c\u9879\u4e3a\u9762\u79ef\uff0c\u7b2c\u4e09\u9879\u4e3a\u5f27\u957f;\n;;;----------------------------------------------------;\n(defun POLY:Info_Bulge (P1 P2 b \/ D A k C R)\n (setq D (distance p1 p2))\n (setq A (angle p1 p2))\n (setq k (* d (1+ (* b b)) 0.25))\n (setq C (polar p1 (+ a (- (* pi 0.5) (* 2 (atan b)))) (\/ k b)))\n (setq R (\/ k (abs b)))\n (CIR:Circular_Segment C R (angle c p1) (angle c p2) (< b 0))\n)\n\n;;;----------------------------------------------------;\n;;;\u83b7\u5f97\u8f7b\u591a\u6bb5\u7ebf\u7684\u4fe1\u606f ;\n;;;\u8f93\u5165: LWPoly---\u8f7b\u591a\u6bb5\u7ebf\u7684\u5b9e\u4f53\u540d ;\n;;;\u8f93\u51fa: \u5217\u8868: \u7b2c\u4e00\u9879\u4e3a\u8d28\u5fc3\uff0c\u7b2c\u4e8c\u9879\u4e3a\u9762\u79ef\uff0c\u7b2c\u4e09\u9879\u4e3a\u5f27\u957f;\n;;;----------------------------------------------------;\n(defun POLY:Info_LWPoly (LWPoly \/ eps Object Points Number IsOpen I P P0 Q Ret b Cen1\n Area1 List1 List2 Part1 Leng1 Leng2 AreaLst CenLst)\n (setq eps 1e-6)\n (setq Object (vlax-ename->vla-object LWPoly))\n (setq Points (vlax-get Object 'Coordinates))\n (setq Number (\/ (length Points) 2))\n (setq IsOpen (= (vla-get-closed Object) :vlax-false))\n (and IsOpen (setq Number (1+ Number)))\n (setq i 0)\n \n (setq p0 (list (car Points) (cadr Points)))\n (setq p p0)\n (repeat number\n (if (setq Points (cddr Points))\n (setq q (list (car Points) (cadr Points))) ;\u4e0b\u4e00\u9876\u70b9\n (setq q P0) ;\u5982\u679c\u9876\u70b9\u662f\u6700\u540e\u70b9\uff0c\u5219\u53d6\u7b2c\u4e00\u70b9\n )\n (if (not (equal p q eps)) ;\u8fd9\u6b65\u4e3a\u7684\u662f\u6d88\u9664\u91cd\u5408\u7684\u70b9\u3002\n (progn\n (setq b (vla-getbulge Object i)) ;\u53d6\u5f97\u8fd9\u70b9\u7684\u51f8\u5ea6\n (if (or (\/= b 0.0) (and (null points) IsOpen)) ;\u5982\u679c\u6709\u51f8\u5ea6\u6216\u8005\u5728\u672b\u7aef\n (setq List1 (cons (list P b 0) List1)) ;\u5219\u4e0d\u8ba1\u7b97\u8fd9\u70b9\u957f\u5ea6\n (setq List1 (cons (list p b (distance p q)) List1)) \n )\n (if (and (\/= b 0.0) (or Points (not IsOpen))) ;\u5982\u679c\u6709\u51f8\u5ea6(\u672b\u7aef\u4e0d\u5c01\u95ed\u60c5\u51b5\u4e0d\u8ba1\u7b97)\n (setq List2 (cons (POLY:Info_Bulge p q b) List2))\n )\n )\n )\n (setq p q)\n (setq i (1+ i))\n )\n (setq list1 (reverse List1))\n (setq list2 (reverse list2))\n (setq part1 (POLY:Infomation (mapcar 'car list1))) ;\u4e0d\u542b\u5f27\u6bb5\u7684\u90e8\u5206\n (setq Cen1 (car Part1)) ;\u4e0d\u542b\u5f27\u6bb5\u90e8\u5206\u7684\u8d28\u5fc3\n (setq Area1 (cadr Part1)) ;\u4e0d\u542b\u5f27\u6bb5\u90e8\u5206\u7684\u9762\u79ef\n (setq leng1 (apply '+ (mapcar 'last list1))) ;\u4e0d\u542b\u5f27\u6bb5\u90e8\u5206\u7684\u603b\u957f\n (if List2 ;\u542b\u5f27\u6bb5\u7684\u90e8\u5206\n (setq leng2 (apply '+ (mapcar 'last list2)) ;\u542b\u5f27\u6bb5\u90e8\u5206\u7684\u603b\u957f\n CenLst (cons Cen1 (mapcar 'car list2)) ;\u542b\u5f27\u6bb5\u90e8\u5206\u7684\u8d28\u5fc3\n AreaLst (cons Area1 (mapcar 'cadr list2)) ;\u542b\u5f27\u6bb5\u90e8\u5206\u7684\u9762\u79ef\n ret (GEO:Centroid_Composition CenLst AreaLst)\n ret (list (car ret) (cadr ret) (+ leng1 leng2))\n ) \n (list Cen1 Area1 leng1)\n )\n)\n\n;;;****************************************************;\n;;;\u6570\u5b66\u90e8\u5206 ;\n;;;****************************************************;\n\n;;;----------------------------------------------------;\n;;;\u53d8\u53f7 ;\n;;;----------------------------------------------------;\n(defun Math:Sign_reversal (y x)\n (if (< x 0) (- y) y)\n)\n\n;;;----------------------------------------------------;\n;;;\u5224\u65ad\u662f\u5426\u5f02\u53f7 ;\n;;;----------------------------------------------------;\n(defun MATH:Opposite_Sign (x y)\n (or (and (> x 0) (< y 0)) (and (< x 0) (> y 0)))\n)\n\n;;;----------------------------------------------------;\n;;;\u5224\u65ad\u662f\u5426\u540c\u53f7 ;\n;;;----------------------------------------------------;\n(defun MATH:Same_Sign (x y)\n (or (and (> x 0) (> y 0)) (and (< x 0) (< y 0)))\n)\n\n;;;****************************************************;\n;;;\u5b9e\u4f53\u521b\u5efa\u90e8\u5206 ;\n;;;****************************************************;\n\n;;;----------------------------------------------------;\n;;;\u521b\u5efa\u4e00\u4e2a\u70b9 ;\n;;;\u8f93\u5165: \u4e00\u4e2a\u4e09\u7ef4\u6216\u8005\u4e8c\u7ef4\u7684\u70b9 ;\n;;;\u8f93\u51fa: \u70b9\u5b9e\u4f53\u7684\u56fe\u5143\u540d ;\n;;;----------------------------------------------------;\n(defun Ent:Make_Point (p)\n (entmakex (list '(0 . \"POINT\") (cons 10 p)))\n)\n\n;;;----------------------------------------------------;\n;;;\u521b\u5efa\u4e00\u4e2a\u5e26\u989c\u8272\u7684\u70b9\uff08\u6b64\u51fd\u6570\u4e3a\u6d4b\u8bd5\u6216\u8005\u5176\u4ed6\u7528\u9014\uff09 ;\n;;;\u8f93\u5165: \u4e00\u4e2a\u4e09\u7ef4\u6216\u8005\u4e8c\u7ef4\u7684\u70b9\u8868\u548c\u4e00\u4e2a\u989c\u8272\u53f7 ;\n;;;\u8f93\u51fa: \u70b9\u5b9e\u4f53\u7684\u56fe\u5143\u540d ;\n;;;----------------------------------------------------;\n(defun Ent:MakePoint-1 (p c)\n (entmakex (list '(0 . \"POINT\") (cons 10 p) (cons 62 c)))\n)\n\n;;;----------------------------------------------------;\n;;;\u521b\u5efa\u4e00\u6761\u76f4\u7ebf\u6bb5 ;\n;;;\u8f93\u5165: \u4e24\u4e2a\u4e09\u7ef4\u6216\u8005\u4e8c\u7ef4\u7684\u70b9 ;\n;;;\u8f93\u51fa: \u7ebf\u6bb5\u5b9e\u4f53\u7684\u56fe\u5143\u540d ;\n;;;----------------------------------------------------;\n(defun Ent:Make_Line (p q)\n (entmakeX (list '(0 . \"LINE\") (cons 10 p) (cons 11 q)))\n)\n\n;;;----------------------------------------------------;\n;;;\u521b\u5efa\u4e00\u4e2a\u7531\u4e09\u6761\u76f4\u7ebf\u7ec4\u6210\u7684\u4e09\u89d2\u5f62 ;\n;;;\u8f93\u5165: \u4e09\u4e2a\u4e09\u7ef4\u6216\u8005\u4e8c\u7ef4\u7684\u70b9 ;\n;;;\u8f93\u51fa: \u7531\u4e09\u6761\u76f4\u7ebf\u7ec4\u6210\u7684\u4e09\u89d2\u5f62 ;\n;;;----------------------------------------------------;\n(defun Ent:Make_Triangle (p1 p2 p3)\n (mapcar 'Ent:Make_Line (list p1 p2 p3) (list p2 p3 p1))\n)\n\n;;;----------------------------------------------------;\n;;;\u521b\u5efa\u4e00\u4e2a\u4e09\u7ef4\u591a\u6bb5\u7ebf ;\n;;;\u8f93\u5165: \u4e09\u7ef4\u7684\u70b9\u96c6 ;\n;;;\u8f93\u51fa: \u4e09\u7ef4\u591a\u6bb5\u7ebf\u5b9e\u4f53 ;\n;;;----------------------------------------------------;\n(defun Ent:Make_Poly (pts \/ e)\n (setq e (Entmake (list '(0 . \"POLYLINE\") '(70 . 9))))\n (foreach p pts\n (entmake (list '(0 . \"VERTEX\") '(70 . 32) (cons 10 p)))\n )\n (entmake '((0 . \"SEQEND\")))\n (entlast)\n)\n\n \n;;;----------------------------------------------------;\n;;;\u521b\u5efa\u8f7b\u591a\u6bb5\u7ebf ;\n;;;\u8f93\u5165: \u4e8c\u7ef4\u7684\u70b9\u96c6 ;\n;;;\u8f93\u51fa: \u8f7b\u591a\u6bb5\u7ebf\u5b9e\u4f53\u540d ;\n;;;----------------------------------------------------;\n(defun Ent:Make_LWPoly (pts closed \/)\n (entmakeX \n (append\n '((0 . \"LWPOLYLINE\")\n (100 . \"AcDbEntity\") \n (100 . \"AcDbPolyline\")\n )\n (list (cons 90 (length pts))) ;\u9876\u70b9\u4e2a\u6570\n (mapcar (function (lambda (x) (cons 10 x))) pts) ;\u591a\u6bb5\u7ebf\u9876\u70b9\n (list (cons 70 (if closed 1 0))) ;\u95ed\u5408\u7684\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u521b\u5efa\u5706\u5b9e\u4f53 ;\n;;;\u8f93\u5165: \u5706\u5fc3C\u548c\u534a\u5f84R ;\n;;;\u8f93\u51fa: \u5706\u7684\u5b9e\u4f53\u540d ;\n;;;----------------------------------------------------;\n(defun Ent:Make_Circle (C R)\n (entmakex (list '(0 . \"CIRCLE\") (cons 10 C) (cons 40 R)))\n)\n\n;;;----------------------------------------------------;\n;;;\u521b\u5efa\u5f27\u5b9e\u4f53\uff08\u6ce8\u610f: \u5f27\u6bb5\u603b\u662f\u9006\u65f6\u9488\u65b9\u5411\u7684\uff09 ;\n;;;\u8f93\u5165: \u5f27\u7684\u5706\u5fc3C\u548c\u534a\u5f84R\u4ee5\u53ca\u8d77\u59cb\u89d2\u5ea6A1\u548c\u7ec8\u6b62\u89d2\u5ea6A2 ;\n;;;\u8f93\u51fa: \u5f27\u7684\u5b9e\u4f53\u540d ;\n;;;----------------------------------------------------;\n(defun Ent:Make_ARC (C R A1 A2)\n (entmakeX (list '(0 . \"ARC\")\n (cons 10 C)\n (cons 40 R)\n (cons 50 A1)\n (cons 51 A2)\n )\n )\n)\n\n;;;****************************************************;\n;;;\u6742\u9879 ;\n;;;****************************************************;\n\n;;;----------------------------------------------------;\n;;;\u8868\u4e2d\u662f\u5426\u5b58\u5728\u67d0\u4e2a\u5143\u7d20 ;\n;;;----------------------------------------------------;\n(defun MISC:IsExist (x lst func \/ f y ret)\n (setq f (eval func))\n (while (setq y (car lst))\n (setq lst (cdr lst))\n (if (f x y)\n (setq ret T lst nil)\n )\n )\n ret\n)\n\n;;;----------------------------------------------------;\n;;;\u6839\u636ex\u7684\u51fd\u6570\u6c42y ;\n;;;----------------------------------------------------;\n(defun MISC:Apply (x y)\n (mapcar 'apply x (mapcar 'list y))\n ;;(mapcar 'eval (mapcar 'list x y)) ;Slower\n)\n\n;;;----------------------------------------------------;\n;;;\u4ea4\u6362\u4e24\u4e2a\u5143\u7d20 ;\n;;;----------------------------------------------------;\n(defun MISC:Swap (e1 e2 \/ temp)\n (setq temp e2 e2 e1 e1 temp)\n (list e1 e2)\n)\n\n;;;----------------------------------------------------;\n;;;\u628a\u8868\u7684\u7b2c\u4e00\u9879\u653e\u5230\u6700\u540e ;\n;;;----------------------------------------------------;\n(defun MISC:1st->Last (lst)\n (append (cdr lst) (list (car lst)))\n)\n\n;;;----------------------------------------------------;\n;;;\u628a2d\u6216\u80053d\u70b9\u96c6\u8f6c\u5316\u4e3a\u8868 ;\n;;;----------------------------------------------------;\n(defun MISC:PtList->List (Ptlst \/ l)\n (reverse\n (foreach p Ptlst\n (foreach x p\n (setq l (cons x l))\n )\n )\n )\n)\n\n;;;----------------------------------------------------;\n;;;\u628a\u8868\u8f6c\u5316\u4e3a2d\u6216\u80053d\u70b9\u96c6 ;\n;;;----------------------------------------------------;\n(defun MISC:List->PtList (lst dim \/ l p x)\n (while lst \n (setq p nil)\n (repeat dim\n (setq p (cons (car lst) p))\n (setq lst (cdr lst))\n )\n (setq l (cons (reverse p) l))\n )\n (reverse l)\n)\n\n;;;----------------------------------------------------;\n;;;\u628a\u8868\u8f6c\u5316\u4e3a\u53d8\u91cf ;\n;;;----------------------------------------------------;\n(defun MISC:List->Variant (Ptlst \/ lst dim arr) ; allocate space for an array of 2d or 3d points stored as doubles\n (setq lst (MISC:PtList->List Ptlst))\n (setq dim (cons 0 (1- (length lst))))\n (setq arr (vlax-make-safearray vlax-vbDouble dim)) ; array dimension, element type is vlax-vbDouble\n (vlax-make-variant (vlax-safearray-fill arr lst)) ; return array variant\n)\n\n;;;----------------------------------------------------;\n;;;\u53d8\u91cf\u8f6c\u5316\u4e3a\u8868 ;\n;;;----------------------------------------------------;\n(defun MISC:Variant->List (var)\n (vlax-safearray->list (vlax-variant-value var))\n)\n\n(defun p-t(p p1 p2)\n (<= (abs (- (\/ (caddr (trans (mapcar '- p p1) 0 (mapcar '- p2 p1))) (distance p1 p2)) 0.5)) (+ 0.5 1e-8))\n)\n\n(defun LINE:P-t (p p1 p2 \/ a b c)\n (setq a (distance p1 p2))\n (setq b (distance p p1))\n (setq c (distance p p2))\n (> (* a a) (abs (* (+ b c) (- b c))))\n)\n\n(defun p-t-1 (p p1 p2)\n (< 0 (caddr (trans (mapcar '- p p1) 0 (mapcar '- p2 p1))) (distance p1 p2))\n)\n\n(defun LINE:p-t-1 (p p1 p2 \/ v)\n (setq v (mapcar '- p2 p1))\n (and\n (> (Mat:dot v (mapcar '- p p1)) 0)\n (> (mat:dot v (mapcar '- p2 p)) 0)\n )\n)\n\n(defun Line:Angle (P0 P1 P2 \/ an)\n (setq an (abs (- (angle p0 P1) (angle P0 P2))))\n (if (> an pi)\n (- (+ pi pi) an)\n an\n )\n)\n \n(defun LINE:p-t-2 (p p1 p2 \/ HalfPi)\n (setq HalfPi (* pi 0.5))\n (and\n (< (Line:angle P1 P0 P2) HalfPi)\n (< (Line:angle P2 P0 P1) HalfPi)\n )\n)\n\n\n;;;----------------------------------------------------;\n;;;\u6d4b\u8bd5\u7528\u51fd\u6570(benchMark function) ;\n;;;----------------------------------------------------;\n(defun MISC:Test (Times Expressions \/ s)\n (defun Benchmark (Func times \/ TDUSRTIMER0 TDUSRTIMER1 Speed Value FName)\n (setq TDUSRTIMER0 (getvar \"TDUSRTIMER\"))\n (repeat times\n (setq Value (eval Func))\n )\n (setq TDUSRTIMER1 (getvar \"TDUSRTIMER\"))\n (setq TDUSRTIMER1 (* (- TDUSRTIMER1 TDUSRTIMER0) 86400000))\n (setq Speed (\/ TDUSRTIMER1 times 1.0))\n (setq FName (vl-princ-to-string (car Func)))\n (list FName times TDUSRTIMER1 Speed Value)\n )\n (defun Princ-Column (str value \/ s)\n (setq s (vl-princ-to-string value))\n (princ s)\n (repeat (- (strlen str) (strlen s))\n (princ \" \")\n )\n )\n (defun Print-Result (lst)\n (princ \"n\")\n (princ-Column \"Statement \" (car lst)) \n (princ-Column \"Times \" (cadr lst)) \n (princ-Column \"Elapse(ms) \" (caddr lst))\n (princ-Column \"Average(ms\/time)\" (cadddr lst))\n )\n \n (foreach Func Expressions \n (setq S (cons (BenchMark Func Times) S))\n )\n\n (princ \"nStatement Times Elapse(ms) Average(ms\/time)\")\n (princ \"n-------------------------------------------------------------------------\")\n (setq s (vl-sort s (function (lambda (a b) (< (caddr a) (caddr b))))))\n (mapcar 'Print-Result s) \n (gc)\n s\n)\n\n;|*****************************************************;\n;;;\u4ee5\u4e0b\u4e3a\u6d4b\u8bd5\u6240\u7528\uff0c\u5927\u5bb6\u53ef\u5404\u53d6\u6240\u9700 ;\n;;;*****************************************************;\n\n(defun c:testPerpendicularFoot (\/ p p0 normal)\n (setq p '(1 2 43))\n (setq p0 (getvar 'ucsorg))\n (setq Normal (trans '(0 0 1) 1 0 T))\n \n (misc:test 10001\n '((PLANE:Perpendicular_Foot p p0 normal)\n (PLANE:Perpendicular_Foot_2 p p0 normal)\n )\n )\n)\n\n;;;\u6d4b\u8bd5\u5750\u6807\u53d8\u6362\u51fd\u6570Mat:TransU2W\u548cTransW2U\n(defun C:TestTransU2W (\/ x y s e d p q v)\n (initget 1)\n (setq x (getdist \"nX:\"))\n (initget 1)\n (setq y (getdist \"nY:\"))\n (initget 1)\n (setq s (ssget \":S\" '((0 . \"LINE\"))))\n (if (and x y s)\n (progn\n (setq e (ssname s 0))\n (setq d (entget e))\n (setq p (cdr (assoc 10 d)))\n (setq q (cdr (assoc 11 d)))\n (setq v (MAT:TransU2W (list x y) p (mapcar '- q p)))\n (Ent:Make_Point V)\n )\n )\n)\n\n;;;\u6d4b\u8bd5\u65cb\u8f6c\u51fd\u6570GEO:Rot2d\n(defun c:TestRot2d ( \/ pt pb an)\n (initget 1)\n (setq pt (getpoint \"n\u8981\u65cb\u8f6c\u7684\u70b9:\"))\n (initget 1)\n (setq pb (getpoint \"n\u57fa\u70b9:\"))\n (initget 1) \n (setq an (getangle \"n\u89d2\u5ea6:\"))\n (ent:make_point pt)\n (ent:make_point pb)\n (ent:make_point (GEO:Rot2d Pt Pb an))\n (princ)\n)\n\n;;;\u6d4b\u8bd5\u955c\u50cf\u51fd\u6570\n(defun c:TestMirror (\/ p1 p2 pt s)\n (initget 1)\n (setq p1 (getpoint \"n1:\"))\n (initget 1)\n (setq p2 (getpoint \"n2:\"))\n (initget 1) \n (setq pt (getpoint \"n\u8981\u955c\u50cf\u7684\u70b9:\"))\n (grdraw p1 p2 1)\n (setq s (MiSC:Test 10000\n '((GEO:Mirror2D pt p1 (angle p1 p2))\n (GEO:Mirror3D Pt p1 p2)\n (GEO:Mirror2D-1 Pt p1 p2)\n )\n )\n )\n (mapcar 'Ent:Make_Line (list pt pt pt) (mapcar 'last s))\n (princ)\n)\n\n;;;\u6d4b\u8bd5\u5782\u8db3\u662f\u5426\u5728\u7ebf\u6bb5\u4e4b\u95f4\n(defun c:ppp ()\n (initget 1)\n (setq p0 (getpoint \"n\u7b2c\u4e00\u70b9\"))\n (initget 1)\n (setq p1 (getpoint \"n\u7b2c\u4e8c\u70b9\"))\n (initget 1)\n (setq p2 (getpoint \"n\u7b2c\u4e09\u70b9\"))\n (if (p-t p0 p1 p2)\n (princ \"n\u4eb2\uff0c\u5728!!!\")\n (princ \"n\u4eb2\uff0c\u4e0d\u5728\u54e6!!!!!\")\n )\n (if (LINE:P-t p0 p1 p2)\n (princ \"n\u4eb2\uff0c\u5728!!!\")\n (princ \"n\u4eb2\uff0c\u4e0d\u5728\u54e6!!!!!\")\n )\n (if (LINE:P-t-2 p0 p1 p2)\n (princ \"n\u4eb2\uff0c\u5728!!!\")\n (princ \"n\u4eb2\uff0c\u4e0d\u5728\u54e6!!!!!\")\n )\n (misc:test\n 100000\n '((LINE:P-t p0 p1 p2)\n (LINE:P-t-1 p0 p1 p2)\n (LINE:P-t-2 p0 p1 p2)\n (p-t p0 p1 p2)\n (p-t-1 p0 p1 p2)\n )\n )\n (princ)\n)\n\n;;;\u6d4b\u8bd5\u5782\u8db3\u548c\u5782\u8ddd\u51fd\u6570\n(defun C:LPF(\/ p1 p2 pt f a b c s)\n (initget 1)\n (setq p1 (getpoint \"n\u76f4\u7ebf\u7aef\u70b91:\"))\n (initget 1)\n (setq p2 (getpoint \"n\u76f4\u7ebf\u7aef\u70b92:\"))\n (initget 1)\n (setq pt (getpoint \"n\u8981\u6c42\u7684\u70b9p:\"))\n\n (setq f (LINE:Equation p1 p2))\n (setq A (car f))\n (setq B (cadr f))\n (setq C (caddr f))\n\n (setq S (MISC:Test 10000 \n '((LINE:Perpendicular_Foot pt p1 p2)\n (LINE:Perpendicular_Foot_1 pt p1 p2)\n (LINE:Perpendicular_Foot_2 pt p1 p2)\n (LINE:Perpendicular_Foot_3 pt p1 p2)\n )\n )\n )\n\n (grdraw p1 p2 1)\n (Ent:Make_Point pt)\n (Ent:MakePoint-1 (cadr (last (car s))) 1)\n (Ent:MakePoint-1 (last (cadr s)) 2)\n (Ent:MakePoint-1 (last (caddr s)) 3)\n (Ent:MakePoint-1 (last (cadddr s)) 4)\n \n (setq S (MISC:Test 10000\n '((LINE:Perpendicular_Foot pt p1 p2)\n (LINE:Perpendicular_Distance_1 pt A B C)\n (LINE:Perpendicular_Distance_2 pt P1 p2)\n (LINE:Perpendicular_Distance_3 Pt P1 P2)\n (MAT:TransW2U pt P1 (mapcar '- p2 p1)))\n )\n )\n \n (princ (mapcar 'last s))\n (princ)\n)\n\n;;;\u6d4b\u8bd5\u7ebf\u6bb5\u76f8\u4ea4\u51fd\u6570\n(defun C:Inters (\/ p1 p2 p3 p4 s)\n (initget 1)\n (setq p1 (getpoint \"n1:\"))\n (initget 1)\n (setq p2 (getpoint p1 \"n2:\"))\n (initget 1)\n (setq p3 (getpoint \"n3:\"))\n (initget 1)\n (setq p4 (getpoint p3 \"n4:\"))\n\n (grdraw p1 p2 1)\n (grdraw p3 p4 2)\n (setq s (MISC:Test 100000\n '((LINE:Intersection p1 p2 p3 p4)\n (inters p1 p2 p3 p4 nil)\n )\n )\n )\n (foreach p (mapcar 'last s)\n (Ent:make_Point p)\n )\n)\n\n;;;\u6d4b\u8bd5\u89d2\u5e73\u5206\u7ebf\u51fd\u6570\n(defun c:pf(\/ e1 e2 d1 d2 p1 p2 p3 p4 ret)\n (setq e1 (car (entsel \"n\u76f4\u7ebf1:\")))\n (setq e2 (car (entsel \"n\u76f4\u7ebf2:\")))\n (setq d1 (entget e1))\n (setq d2 (entget e2))\n (setq p1 (cdr (assoc 10 d1)))\n (setq p2 (cdr (assoc 11 d1)))\n (setq p3 (cdr (assoc 10 d2)))\n (setq p4 (cdr (assoc 11 d2)))\n (setq ret (LINE:Angular_Bisector p1 p2 p3 p4))\n (foreach n ret\n (apply 'Ent:Make_line n)\n )\n)\n\n;;;\u6d4b\u8bd5\u504f\u79fb\u4e24\u70b9\u51fd\u6570LINE:Offset\n(defun C:LineOffset (\/ p1 p2 d)\n (initget 1)\n (setq p1 (getpoint \"n1:\"))\n (initget 1)\n (setq p2 (getpoint p1 \"n2:\"))\n (initget 1)\n (setq d (getdist p1 \"n\u504f\u79fb\u8ddd\u79bb:\"))\n (Ent:make_line p1 p2)\n (apply 'Ent:make_line (LINE:Offset p1 p2 d))\n (princ)\n)\n\n;;;\u6d4b\u8bd5\u5171\u7ebf\u68c0\u6d4b\u51fd\u6570LINE:Colinearity,LINE:Colinearity_1\n(defun C:Colinearity (\/ p1 p2 p3)\n (setq eps 1e-6)\n (setq p1 (getpoint \"n1:\"))\n (setq p2 (getpoint \"n2:\"))\n (setq p3 (getpoint \"n3:\"))\n (MISC:Test 100000\n '((LINE:Colinearity p1 p2 p3)\n (LINE:Colinearity3D p1 p2 p3)\n )\n )\n (princ)\n)\n\n;;;\u5e73\u9762\u90e8\u5206\u6d4b\u8bd5\u51fd\u6570\n(defun c:PlaneTest(\/ pa pb p1 p2 p3 d1 d2 arg)\n (initget 1)\n (setq pa (getpoint \"npa:\"))\n (setq pa (trans pa 1 0))\n (initget 1)\n (setq pb (getpoint \"npb:\"))\n (setq pb (trans pb 1 0))\n \n (initget 1)\n (setq p1 (getpoint \"n1:\"))\n (setq p1 (trans p1 1 0))\n (initget 1)\n (setq p2 (getpoint \"n2:\"))\n (setq p2 (trans p2 1 0))\n (initget 1)\n\n (setq p3 (getpoint \"n3:\"))\n (setq p3 (trans p3 1 0))\n \n (mapcar 'Ent:make_Point (list pa pb p1 p2 p3))\n \n (princ (PLANE:Distance_1 Pa p1 p2 p3))\n \n (setq d1 (PLANE:Perpendicular_Foot Pa p1 p2 p3))\n (setq d2 (PLANE:Perpendicular_Foot Pb p1 p2 p3))\n (setq arg (cons pa (cons Pb (PLANE:Equation_3P p1 p2 p3))))\n (setq ret (apply 'PLANE:Line_Inters_Plane arg))\n (Ent:make_Point (cadr d1))\n (Ent:make_Point (cadr d2))\n (Ent:make_Point ret)\n (princ (LINE:Distance_LineToLine pa pb p1 p2))\n (princ)\n)\n\n;;;\u4e09\u7ebf\u5750\u6807\u7cfb\u7edf\u6d4b\u8bd5\n(defun C:InfoBy3Sides (\/ p1 p2 p3 a b c ret)\n (initget 1)\n (setq p1 (getpoint \"n1:\"))\n (initget 1)\n (setq p2 (getpoint \"n2:\"))\n (initget 1)\n (setq p3 (getpoint \"n3:\"))\n (setq p1 (trans p1 1 0))\n (setq p2 (trans p2 1 0))\n (setq p3 (trans p3 1 0))\n (setq a (distance p2 p3))\n (setq b (distance p3 p1))\n (setq c (distance p1 p2))\n (Ent:make_Poly (list p1 p2 p3))\n (setq ret (TRI:InfoBy3Sides a b c))\n (princ ret)\n (foreach n (cddr ret)\n (setq p (TRI:TCS->WCS (car n) p1 p2 p3))\n (Ent:make_Point p)\n (if (setq r (cadr n))\n (Ent:make_Circle p r)\n )\n )\n (princ)\n)\n\n;;;Test for \"POLY:Info_LWPoly\" \"Geo:Centroid\" \"POLY:Area\" \"POLY:Perimeter\" \"POLY:Infomation\"\n;;;\u4e3a\u6bb5\u7ebf\u7684\u8d28\u5fc3\u548c\u9762\u79ef\u7684\u6d4b\u8bd5\n(defun C:CentroidTest (\/ sel ent en1 dxf pts cen aaa len ret i)\n (setq i -1)\n (setq sel (ssget '((0 . \"*POLYLINE\"))))\n (if sel\n (repeat (sslength sel)\n (setq ent (ssname sel (setq i (1+ i))))\n (setq obj (vlax-ename->vla-object ent))\n (setq dxf (entget ent))\n (if (= (cdr (assoc 0 DXF)) \"POLYLINE\")\n (setq pts (MISC:List->PtList (vlax-get obj 'coordinates) 3)\n Cen (GEO:Centroid pts)\n aaa (POLY:Area pts)\n len (POLY:Perimeter pts)\n ret (POLY:Infomation pts)\n en1 (Ent:MakePoint-1 Cen 2) \n )\n (setq ret (POLY:Info_LWPoly ent)\n aaa (vla-get-area obj)\n )\n )\n (setq cen (car ret))\n (setq len (vla-get-length obj))\n (Ent:MakePoint-1 cen 1)\n (princ (strcat \"n\u7b2c\" (itoa i) \"\u4e2a\u7269\u4f53\u4fe1\u606f: \"))\n (princ (list ret Cen aaa len))\n (princ)\n )\n )\n)\n\n;;;\u5f27\u6bb5\u7684\u8d28\u5fc3\u548c\u9762\u79ef\u7684\u6d4b\u8bd5\n(defun C:TestArcCentroid (\/ A1 A2 C R E1 I O1 O2 O3 O4 P1 P2 S1 S2 SS V3 V4)\n (setq i -1)\n (if (setq ss (ssget '((0 . \"ARC\"))))\n (repeat (sslength ss)\n (setq e1 (ssname ss (setq i (1+ i))))\n (setq o1 (vlax-ename->vla-object e1))\n\n (setq C (vlax-get o1 'Center))\n (setq R (vla-get-radius o1))\n (setq A1 (vla-get-startangle o1))\n (setq A2 (vla-get-endangle o1))\n\n (setq V3 (CIR:Circular_Segment C R A1 A2 nil)) ;\u5706\u5f27\u603b\u662f\u9006\u65f6\u9488\u7684\n (setq V4 (CIR:Circular_Sector C R A1 A2 nil)) ;\u5706\u5f27\u603b\u662f\u9006\u65f6\u9488\u7684\n\n (setq p1 (vlax-curve-getstartpoint e1)) ;\u5f27\u8d77\u70b9\n (setq p2 (vlax-curve-getendPoint e1)) ;\u5f27\u7ec8\u70b9\n (setq s1 (ssadd e1))\n (setq s1 (ssadd (Ent:Make_Line p1 p2) S1))\n\n (setq o2 (vla-copy o1)) ;\u62f7\u8d1d\u5706\u5f27\u7528\u6765\u6d4b\u8bd5\u6247\u5f62\n (setq s2 (ssadd (vlax-vla-object->ename o2)))\n (setq s2 (ssadd (Ent:Make_Line p1 C) s2))\n (setq s2 (ssadd (Ent:Make_Line p2 C) s2))\n\n (command \"region\" s1 \"\") ;\u5f13\u5f62\u8ba1\u7b97\u4e0e\u5efa\u6a21\u505a\u6bd4\u8f83\n (setq o3 (vlax-ename->vla-object (entlast)))\n (command \"region\" s2 \"\") ;\u6247\u5f62\u8ba1\u7b97\u4e0e\u5efa\u6a21\u505a\u6bd4\u8f83\n (setq o4 (vlax-ename->vla-object (entlast)))\n\n (Ent:MakePoint-1 (car V3) 1) ;\u8ba1\u7b97\u51fa\u6765\u7684\u5f13\u5f62\u8d28\u5fc3\n (Ent:MakePoint-1 (car V4) 2) ;\u8ba1\u7b97\u51fa\u6765\u7684\u6247\u5f62\u8d28\u5fc3\n (Ent:MakePoint-1 (vlax-get o3 'centroid) 3) ;\u5f13\u5f62\u5efa\u6a21\u7684\u8d28\u5fc3\n (Ent:MakePoint-1 (vlax-get o4 'centroid) 4) ;\u6247\u5f62\u5efa\u6a21\u7684\u8d28\u5fc3\n\n (princ (list V3 (vla-get-area O3) (vla-get-perimeter O3)))\n (princ (list V4 (vla-get-area O4) (vla-get-perimeter O4)))\n (princ)\n )\n )\n)\n;;;\u6d4b\u8bd53\u70b9\u7684\u884c\u5217\u5f0f\n(defun c:ttt()\n (initget 1)\n (setq p1 (getpoint \"n1:\"))\n (initget 1)\n (setq p2 (getpoint p1 \"n2:\"))\n (initget 1)\n (setq p3 (getpoint \"n3:\"))\n\n (setq s (MISC:Test 100000\n '((TRI:Det3p p1 p2 p3))\n )\n )\n (princ (mapcar 'last s))\n (princ)\n) \n;;;\u83b7\u53d6\u622a\u9762\u7684\u8d28\u5fc3\n(defun C:GetRegionCentroid (\/ sel ent obj i)\n (setq i -1)\n (if (setq sel (ssget '((0 . \"REGION\"))))\n (repeat (sslength sel)\n (setq ent (ssname sel (setq i (1+ i))))\n (setq obj (vlax-ename->vla-object ent))\n (Ent:MakePoint-1 (vlax-get obj 'Centroid) 3)\n )\n )\n)\n;|;\n<\/pre>\n","protected":false},"excerpt":{"rendered":"\u5bf9CAD\u4e2d \u5173\u4e8e\u76f4\u7ebf\uff0c\u70b9\uff0c\u7ebf\u6bb5\u7684\u4e00\u4e9b\u7814\u7a76\uff0c\u5305\u542b\u4e86\u5927\u91cf\u5b9e\u7528\u51fd\u6570\u3002 \u5176\u4e2d\u70b9\u7684\u5b9a\u5206\u6bd4\uff0c\u76f4\u7ebf\u7684\u76f8\u4ea4\uff0c\u4ee5\u53ca\u7a7a\u95f4\u76f4\u7ebf\u7684\u76f8\u4ea4<\/p>\n