[求助]：如何编程求一直线与一圆的交点及两交点的距离

xuweiwei417 · 发表于 2005-12-27 10:31:47

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

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

×

如何编程求一直线与一圆的交点及两交点的距离
希望能提供编程思想

21cn · 发表于 2005-12-27 16:06:40

(defun c:tt (/ e1 e2 el1 el2 cen r pl p1 p2)
(if (and (setq e1 (car (entsel "\nPick Circle ...")))
(setq el1 (entget e1))
(= (cdr (assoc 0 el1)) "CIRCLE")
(setq e2 (car (entsel "\nPick Line ...")))
(setq el2 (entget e2))
(= (cdr (assoc 0 el2)) "LINE")
)
(progn
(setq cen (cdr (assoc 10 el1))
r (cdr (assoc 40 el1))
)
(if (<= (distance cen (vlax-curve-getclosestpointto e2 cen))
r
)
(progn
(princ "\n")
(setq pl (safearray-value
(variant-value
(vla-intersectwith
(vlax-ename->vla-object e1)
(vlax-ename->vla-object e2)
acextendnone
)
)
)
)
(princ (setq p1 (list (car pl)
(cadr pl)
(caddr pl)
)
)
)
(princ "\n")
(princ (setq p2 (list (nth 3 pl)
(nth 4 pl)
(last pl)
)
)
)
(princ "\nDistance = ")
(princ (distance p1 p2))
)
(princ "\nNo Inters!")
)
)
)
(princ)
)

(defun c:tt (/ e1 e2 el1 el2 cen r pl p1 p2) 
  (if (and (setq e1 (car (entsel "\nPick Circle ..."))) 
           (setq el1 (entget e1)) 
           (= (cdr (assoc 0 el1)) "CIRCLE") 
           (setq e2 (car (entsel "\nPick Line ..."))) 
           (setq el2 (entget e2)) 
           (= (cdr (assoc 0 el2)) "LINE") 
      ) 
    (progn 
      (setq cen        (cdr (assoc 10 el1)) 
            r        (cdr (assoc 40 el1)) 
      ) 
      (if (<= (distance cen (vlax-curve-getclosestpointto e2 cen)) 
              r 
          ) 
        (progn 
          (princ "\n") 
          (setq        pl (safearray-value 
                     (variant-value 
                       (vla-intersectwith 
                         (vlax-ename->vla-object e1) 
                         (vlax-ename->vla-object e2) 
                         acextendnone 
                       ) 
                     ) 
                   ) 
          ) 
          (princ (setq p1 (list        (car pl) 
                                (cadr pl) 
                                (caddr pl) 
                          ) 
                 ) 
          ) 
          (princ "\n") 
          (princ (setq p2 (list        (nth 3 pl) 
                                (nth 4 pl) 
                                (last pl) 
                          ) 
                 ) 
          ) 
          (princ "\nDistance = ") 
          (princ (distance p1 p2)) 
        ) 
        (princ "\nNo Inters!") 
      ) 
    ) 
  ) 
  (princ) 
)

原地踏步 · 发表于 2005-12-27 21:44:16

记得R12中的DLINE.LSP吗？其中就有你想要的。
基本思路为：从圆心ptc做直线的垂线，交点pti，两点距离L若小于半径rad，则有两个交点。从圆心至其中一个交点pt1做直线，长度为半径rad。直角三角形已知两条边长度，可求其夹角ang1，又(setq ang2 (angle ptc pti))，则pt1角度ang为(- ang2 ang1)，可求出pt1坐标 (polar ptc ang rad),另一交点pt2角度为 (+ ang2 ang1)，两点距离为 (distance pt1 pt2)。

yshf · 发表于 2005-12-28 16:28:48

;请试用以下程序
;采用传统的LISP方法求解 by yshf

(defun c:cc()
(while (progn
(setq en1 (entsel "\n请选择直线段：") ent1 (car en1))
(or (= en1 nil) (not (= (setq na (cdr (assoc 0 (setq lin (entget ent1))))) "LINE")))
)
(alert "选中的不是直线，请重新选择直线段！")
)
(while (progn
(setq en2 (entsel "请选择圆：") ent2 (car en2))
(or (= en2 nil) (not (= (setq na (cdr (assoc 0 (setq lin (entget ent2))))) "CIRCLE")))
)
(alert "选中的不是圆，请重新选择圆！")
)
(command "_undo" "be")
(setq p10 (cdr (assoc 10 (entget ent1)))
p11 (cdr (assoc 11 (entget ent1)))
ptb nil
pjd nil
)
(while (progn (command "_extend" ent2 "" (list ent1 p10) "")
(setq pjd (cdr (assoc 10 (entget ent1))))
(not (equal p10 pjd))
)
(setq ptb (cons pjd ptb)
p10 pjd
)
)
(while (progn (command "_extend" ent2 "" (list ent1 p11) "")
(setq pjd (cdr (assoc 11 (entget ent1))))
(not (equal p11 pjd))
)
(setq ptb (cons pjd ptb)
p11 pjd
)
)
(command "_undo" "e")(command "u")
(cond ((= ptb nil) (alert "直线与圆没有交点!"))
((= (length ptb) 1)
(alert
(strcat "直线与圆只有一个交点：("
(rtos (car (car ptb)) 2 3) ", " (rtos (cadr (car ptb)) 2 3) ")"
)
)
)
((= (length ptb) 2)
(alert (strcat "直线与圆的两个交点为："
"\n (" (rtos (car (car ptb)) 2 3) ", " (rtos (cadr (car ptb)) 2 3) ")"
"\n (" (rtos (car (cadr ptb)) 2 3) ", " (rtos (cadr (cadr ptb)) 2 3) ")"
"\n距离为：" (rtos (distance (car ptb) (cadr ptb)) 2 3)
)
)
)
)
(princ)
)

(defun c:cc() 
    (while (progn 
             (setq en1 (entsel "\n请选择直线段：") ent1 (car en1)) 
             (or (= en1 nil) (not (= (setq na (cdr (assoc 0 (setq lin (entget ent1))))) "LINE"))) 
           ) 
       (alert "选中的不是直线，请重新选择直线段！")    
    ) 
    (while (progn 
             (setq en2 (entsel "请选择圆：") ent2 (car en2)) 
             (or (= en2 nil) (not (= (setq na (cdr (assoc 0 (setq lin (entget ent2))))) "CIRCLE"))) 
           ) 
       (alert "选中的不是圆，请重新选择圆！")      
    ) 
    (command "_undo" "be") 
    (setq p10 (cdr (assoc 10 (entget ent1))) 
          p11 (cdr (assoc 11 (entget ent1))) 
          ptb nil 
          pjd nil 
    ) 
    (while (progn (command "_extend" ent2 "" (list ent1 p10) "") 
                  (setq pjd (cdr (assoc 10 (entget ent1)))) 
                  (not (equal p10 pjd)) 
           ) 
                        
       (setq ptb (cons pjd ptb) 
             p10 pjd 
       ) 
    ) 
    (while (progn (command "_extend" ent2 "" (list ent1 p11) "") 
                  (setq pjd (cdr (assoc 11 (entget ent1)))) 
                  (not (equal p11 pjd)) 
           ) 
                        
       (setq ptb (cons pjd ptb) 
             p11 pjd 
       ) 
    ) 
    (command "_undo" "e")(command "u") 
    (cond ((= ptb nil) (alert "直线与圆没有交点!")) 
          ((= (length ptb) 1) 
           (alert 
              (strcat "直线与圆只有一个交点：(" 
                      (rtos (car (car ptb)) 2 3) ", " (rtos (cadr (car ptb)) 2 3) ")" 
              ) 
           ) 
          ) 
          ((= (length ptb) 2) 
           (alert (strcat "直线与圆的两个交点为：" 
                          "\n   (" (rtos (car (car ptb)) 2 3) ", " (rtos (cadr (car ptb)) 2 3) ")" 
                          "\n   (" (rtos (car (cadr ptb)) 2 3) ", " (rtos (cadr (cadr ptb)) 2 3) ")"            
                          "\n距离为：" (rtos (distance (car ptb) (cadr ptb)) 2 3) 
                  ) 
           ) 
         ) 
    ) 
    (princ) 
)

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

[求助]：如何编程求一直线与一圆的交点及两交点的距离

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

相关帖子

浏览过的版块