[LISP函数]：计算到指定点指定距离的点的点位

zml84 · 发表于 2007-8-22 15:47:00

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;=================================================================
;;;计算到指定点指定距离的点的点位
;;;参数：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)
)

;;;================================================================= 
;;;计算到指定点指定距离的点的点位                                    
;;;参数：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) 
)

saiwow · 发表于 2007-9-3 10:39:52

噢。。下载来看看先呵呵
谢谢了。。呵呵。。。。。。。。。。。。。。。

zooloo · 发表于 2007-9-12 09:56:09

不知所言，到指定点指定距离的点不是一个圆吗？

zml84 · 发表于 2007-9-12 11:34:32

回复楼上：距离不一定相等。

账号		自动登录	找回密码
密码			立即注册

[LISP函数]：计算到指定点指定距离的点的点位

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子