这是一个LISP函数，用于计算并返回到指定点指定距离的点位。函数根据输入参数lst（包含点和距离的列表）及参考点pt，通过角度和距离计算点位。如果(lst只有一个元素且有pt)，返回距pt最近的点；如果(lst有两个元素)，返回两个结果点位中距pt最近的一个；如果有三个或更多元素，先计算三个点位，再过滤不符合条件的点位，最终返回满足条件的点位。
;;;=================================================================
;;;计算到指定点指定距离的点的点位
;;;参数：lst --- 格式为 ((pt1 d1) (pt2 d2) ...)
;;; pt --- 参考值，若结果有多个，
;;; 则只返回距 pt 最近的那个点
;;;返回值：若成功则返回点位；若不成功则返回 nil
;|;;备忘：
1、若lst中只有一个，且有pt则返回：
(polar pt1 (angle pt1 pt) d1)
2、若有两个，则计算出两个结果点位后，
若有pt 则过滤；若无 pt 则返回两个点。
3、若有三个及以上，则先计算三个，找出一个点位，
进而复核后面的，当有任何一个不满足时，返回 nil
若全部满足，则返回 结果点位。
;;|;
(defun JS-PT-DIST (LST PT / PT1 PT2 D1 D2 D ANG ANG1 PT_LST)
(cond
;;
((= LST NIL)
NIL
)
;;
((= (length LST) 1)
(if PT
(progn
(setq LST (car LST)
PT1 (car LST)
D1 (cadr LST)
)
(polar PT1 (angle PT1 PT) D1)
)
NIL
)
)
;;
((= (length LST) 2)
(setq PT1 (car (car LST))
D1 (cadr (car LST))
PT2 (car (cadr LST))
D2 (cadr (cadr LST))
)
(setq D (distance PT1 PT2)
ANG (angle PT1 PT2)
)
;;判断是否能够构成几何图形
(if (or (< (+ D1 D2) D)
(< (+ D1 D) D2)
(< (+ D2 D) D1)
)
NIL
(progn
(setq ANG1 (ACOS (/ (- (* D2 D2) (* D1 D1) (* D D))
(* -2.0 D1 D)
)
)
)
;;清空lst表，装进结果点位
(setq LST '()
LST (cons (polar PT1 (+ ANG ANG1) D1) LST)
LST (cons (polar PT1 (- ANG ANG1) D1) LST)
)
(if PT
;;比较位置，看哪一个点离 pt 更近
(if (< (distance (car LST) PT)
(distance (cadr LST) PT)
)
(car LST)
(cadr LST)
)
LST
)
)
)
)
;;
((>= (length LST) 3)
;;先计算前两个点的返回值
(if (setq PT_LST (JS-PT-DIST (list (car LST) (cadr LST)) NIL))
(progn
;;若有结果，则检查是否也满足后面的要求
(foreach N (cddr LST)
(if (and PT_LST
(equal (cadr N)
(distance (car N) (car PT_LST))
1e-10
)
)
()
(setq PT_LST (cdr PT_LST))
)
)
(if (and (= (length PT_LST) 2)
PT
)
;;比较位置，看哪一个点离 pt 更近
(if (< (distance (car PT_LST) PT)
(distance (cadr PT_LST) PT)
)
(car PT_LST)
(cadr PT_LST)
)
(car PT_LST)
)
)
NIL
)
)
) ;_结束cond
) ;_结束defun
;;;=================
;;;测试
;;;(JS-PT-DIST '(((0 0)80) ((100 0)60)) '(80 80))
(defun C:TT (/ D1 D2 PT PT1 PT2)
(if (and (setq PT1 (getpoint "\n第一点: "))
(setq D1 (getdist PT1 " >>>距离: "))
(setq PT2 (getpoint "\n第二点: "))
(setq D2 (getdist PT2 " >>>距离: "))
(setq PT (getpoint "\n参考点: "))
)
(princ (JS-PT-DIST (list (list PT1 D1) (list PT2 D2)) PT))
)
(princ)
)
扫一扫
2239
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
