日志正文
|
||
通用函数 几何算法 点.lsp;;;=================================================================* ;;; 二维点 由 直角坐标系 转到 极坐标系 * (defun XY->RA (XY) (list (distance '(0 0) XY) (angle '(0 0) XY)) ) ;;;=================================================================* ;;; 二维点 由 极坐标系 转到 直角坐标系 * (defun RA->XY (RA) (list (* (car RA) (cos (cadr RA))) (* (car RA) (sin (cadr RA))) ) ) ;;;=================================================================* ;;;极坐标系中二维点 旋转 * (defun RA-ROTATE (RA ANG) (list (car RA) (+ (cadr RA) ANG)) ) ;;;=================================================================* ;;;直角坐标系中二维点 平移 * (defun XY-MOVE (XY XY0) (mapcar '+ XY XY0) ) ;;;=================================================================* ;;; 直角坐标系中二维点 绕指定基点 旋转 指定角度 * (defun ZL-ROTATE (PT BASEPOINT ROTATIONANGLE) (mapcar '+ (RA->XY (RA-ROTATE (XY->RA (mapcar '- PT BASEPOINT)) ROTATIONANGLE ) ) BASEPOINT ) ) ;|;; 问题的提出: 曹*(****00466) 17:03:52 一个点集lst,基点p,角度ang 将点集lst以p为基点旋转ang度,大家有没有最简练的函数 ;;|; ;;;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\* ;;; 露水2 的方法,借助polar * ;;;================================================* ;;; 直角坐标系中二维点 绕指定基点 旋转 指定角度 * (defun PT-ROTATE (PT BASEPOINT ANG) (polar BASEPOINT (+ ANG (angle BASEPOINT PT)) (distance BASEPOINT PT) ) ) ;;;=================================================================* ;;;=================================================================* ;;;功能:二维平面上,计算 指定点 到直线的距离 * ;;;参数:PT -----指定点 * ;;; pt0-----直线上一点 * ;;; pt1-----直线上第二点 * ;;;返回:距离值。左正右负,0表示在直线上。 * ;;;思路:先三点求面积,然后面积除以0.5倍直线段长度,即可得到结果。 * ;;;测试:(ZL-POINT-GETDIST-TOLINE '(3 5) '(0 1)'( 10 0)) * ;;; (ZL-POINT-GETDIST-TOLINE '(3 -5) '(0 1)'( 10 0)) * ;;;日期:zml84 于 2009-05-13 * (defun ZL-POINT-GETDIST-TOLINE (PT PT0 PT1 / AREA DIST) ;;二维化 (setq pt (list (car pt)(cadr pt)) pt0 (list (car pt0)(cadr pt0)) pt1 (list (car pt1)(cadr pt1)) ) ;;面积 (setq AREA (apply '+ (mapcar '(lambda (A B) (- (* 0.5 (car A) (cadr B)) (* 0.5 (cadr A) (car B)) ) ) (list PT PT0 PT1) (list PT0 PT1 PT) ) ) ) ;;直线段长度 (setq DIST (distance PT0 PT1)) ;;返回 (if (equal DIST 0 1e-10) (distance PT PT0) (/ AREA 0.5 DIST) ) ) ;;;=================================================================* ;;;功能:二维平面上,计算 点到直线 的垂足 * ;;;返回:垂足点坐标 (defun zl-inters-PT-LINE (pt ptA ptB) (inters pta ptb pt (polar pt (+ (angle pta ptb) (* 0.5 pi)) 10.0) nil ) ) ;;;=================================================================* ;;;功能:二维平面上,计算 直线与圆 的交点 * ;;;参数: pta -----直线端点1 * ;;; ptb -----直线端点2 * ;;; ptc -----圆心坐标 * ;;; R -----圆半径 * ;;;返回:两个点 (defun zl-inters-Line-Circle (pta ptb ptc R / dist pt_tmp ang dist2) ;;参数整理 (setq r (abs r)) (if (and (setq dist (ZL-POINT-GETDIST-TOLINE PTc PTa PTb)) ;_圆心到直线距离 (setq dist (abs dist)) (<= dist r) ;_相割或相切 ) (progn (setq pt_tmp (zl-inters-PT-LINE ptc ptA ptB) ;_垂足点 ang (angle pta ptb) dist2 (sqrt (- (* r r) (* dist dist))) ) ;;返回 (list (polar pt_tmp ang dist2) (polar pt_tmp ang (- dist2)) ) ) ) ) ;;;=================================================================* ;;测试:直线圆相交 ;;;(defun c:tt () ;;; (if (and (setq en1 (car (entsel "\n点取直线: "))) ;;; (setq ent1 (entget en1)) ;;; (setq pta (cdr (assoc 10 ent1))) ;;; (setq ptb (cdr (assoc 11 ent1))) ;;; ;;; (setq en2 (car (entsel "\n点取圆: "))) ;;; (setq ent2 (entget en2)) ;;; (setq ptc (cdr (assoc 10 ent2))) ;;; (setq R (cdr (assoc 40 ent2))) ;;; ;;; (setq tmp (zl-inters-Line-Circle pta ptb ptc R )) ;;; ) ;;; (command "_.line" "non"(trans (car tmp) 0 1) "non"(trans (cadr tmp) 0 1) "") ;;; ) ;;;) ;;;=================================================================* ;;;功能:二维平面上,计算 圆与圆 的交点 * ;;;返回:两个点 (defun zl-inters-Circle-Circle (ptc1 R1 ptc2 R2 / dist ang tmp ang1) (if (and (setq dist (distance PTc1 PTc2)) ;_圆心到圆心距离 (<= (abs (- r1 r2)) dist (+ r1 r2)) ;_相割或相切 ) (progn (setq ang (angle ptc1 ptc2)) (setq tmp (/ (+ (* dist dist) (* R1 R1) (* -1 R2 R2)) (* 2 dist R1) ) ang1 (ACOS tmp) ) ;;返回 (list (polar ptc1 (+ ang ang1) R1) (polar ptc1 (- ang ang1) R1) ) ) ) ) ;;;=================================================================* ;;测试:圆圆相交 ;;;(defun c:tt () ;;; (if (and (setq en1 (car (entsel "\n点取圆1: "))) ;;; (setq ent1 (entget en1)) ;;; (setq ptc1 (cdr (assoc 10 ent1))) ;;; (setq R1 (cdr (assoc 40 ent1))) ;;; ;;; (setq en2 (car (entsel "\n点取圆2: "))) ;;; (setq ent2 (entget en2)) ;;; (setq ptc2 (cdr (assoc 10 ent2))) ;;; (setq R2 (cdr (assoc 40 ent2))) ;;; ;;; (setq tmp (zl-inters-Circle-Circle ptc1 R1 ptc2 R2)) ;;; ) ;;; (command "_.line" "non"(trans (car tmp) 0 1) "non"(trans (cadr tmp) 0 1) "") ;;; ) ;;;) ;;;=================================================================* ;;;=================================================================* ;;;功能:判断点在多边形的位置 ;;;参数:LST_PT ----多边形轮廓线二维点表 ;;; PT ----欲考察的点位 ;;; FUZZ ----控制精度 ;;;返回:-1 表示在多边形外部; ;;; 0 表示在多边形顶点; ;;; 1 表示在多边形边上。 ;;; 2 表示在多边形内部。 (defun ZML-P (LST_PT PT FUZZ / ZML-P-01 TEST_0 TEST_1 PT0 I0 PT1 I1 I SUM II TMP) ;;=========================== (defun ZML-P-01 (PTN PT FUZZ / X Y II) ;;1.计算相对坐标 (setq PTN (mapcar '- PTN PT)) ;;2.划分象限 ;;(x轴正半轴属于1象限 , y轴正半轴属于2象限...) (setq X (car PTN) Y (cadr PTN) ) (setq II (cond ((and (> X 0) (>= Y 0) ) 1 ) ((and (<= X 0) (> Y 0) ) 2 ) ((and (< X 0) (<= Y 0) ) 3 ) ((and (>= X 0) (< Y 0) ) 4 ) ) ;_结束cond ) (list II X Y) ) ;;=========================== ;;1.初始化 (setq TEST_0 NIL) ;_是否在顶点的标识 (setq TEST_1 NIL) ;_是否在边上的标识 (setq PT0 (ZML-P-01 (last LST_PT) PT FUZZ) I0 (car PT0) PT0 (cdr PT0) ) (setq I 0 SUM 0 ) (if (or (equal PT0 '(0 0) FUZZ) (equal PT0 '(0 0 0) FUZZ) ) (setq TEST_0 t) ;_在顶点上 ) ;;2.循环执行 (while (and (not TEST_0) (not TEST_1) (< I (length LST_PT)) ) ;;2.1.计算象限 (setq PT1 (ZML-P-01 (nth I LST_PT) PT FUZZ) I1 (car PT1) PT1 (cdr PT1) ) ;;2.2.判断点的位置 (cond ((or (equal PT1 '(0 0) FUZZ) (equal PT1 '(0 0 0) FUZZ) ) (setq TEST_0 t) ;_在顶点上 ) ;;4.考察相邻的点的象限关系 ((and (setq II (- I1 I0)) (= II 0) ) () ) ((or (= II 1) (= II -3) ) (setq SUM (1+ SUM)) ) ((or (= II -1) (= II 3) ) (setq SUM (1- SUM)) ) ;;_对角象限 (t (setq TMP (- (* (car PT0) (cadr PT1)) (* (cadr PT0) (car PT1)) ) ) (cond ((equal TMP 0 FUZZ) (setq TEST_1 t) ;_在边上 ) ((> TMP 0) (setq SUM (+ SUM 2)) ) (t (setq SUM (- SUM 2)) ) ) ) ) ;_结束cond ;;; (princ "\nsum:") ;;; (princ SUM) ;;; (princ " ") (setq i (1+ i) I0 I1 PT0 PT1 ) ) ;_结束while ;;3.返回 (cond (TEST_0 0 ;_返回0 表示在顶点 ) (TEST_1 1 ;_返回1 表示在边上 ) ((= SUM 0) -1 ;_返回-1 表示在外部 ) ((= (rem SUM 4) 0) 2 ;_返回2 表示在内部 ) (t -1 ;_返回-1 表示在外部 ) ) ;_结束cond ) ;_结束 defun ;;;=================================================================*
最后修改于 2020-02-03 14:38
阅读(?)评论(0)
上一篇: 帮忙处理字符串.lsp
下一篇:2018-04-28语音函数练习
|
||
评论 想第一时间抢沙发么?