[VVA]

Код:

[Выделить все]

;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-geom-inters-circle-line
;;; *
;;; * 06/12/2007 Версия 0001.
;;; ************************************************************************
(defun dwgru-geom-inters-circle-line (P1 P2 Pc R / A An D Ph)
;;; Пересечение прямой и окружности, лежащих в одной плоскости
;;; Математическое решение
;;;-----------------------------------------------------------
;;;Параметры:
;;;P1, P2 — точки задающие прямую
;;;Pc — центр окружности
;;;R — радиус окружности
;;; Возвращает: Список точек пересечения или nil если не пересекаются
;;;  
 (setq A (angle P1 P2)
       An (+ A (* 0.5 PI))
       Ph (inters P1 P2 Pc (polar Pc An 1000.0) nil)
       D (distance Ph Pc)
 )
 (cond
  ((equal D R 1e-6) (list Ph Ph))
  ((> D R) nil)
  (T (setq D (sqrt (- (* R R) (* D D)))) (list (polar Ph A D) (polar Ph A (- D))))
 )
)

[VVA]

Пример

Код:

[Выделить все]

(defun C:TEST()
  (setvar "CMDECHO" 0)
  (and
    (princ "\nВыберите круг")
    (setq ss nil ss (ssget "_:S:E:L" '((0 . "CIRCLE"))))
    (setq circ1 (ssname ss 0))
    (setvar "CLAYER" (cdr(assoc 8 (entget circ1))))
    (setq Pc (cdr(assoc 10 (entget circ1))))
    (setq R (cdr(assoc 40 (entget circ1))))
    (setq Pc (trans Pc 1 0))
    (while (and
               (setq P1 (getpoint "\nУкажите 1-ю точку отрезка <выход>: "))
               (setq P2 (getpoint P1 "\nУкажите 2-ю точку отрезка <выход>: "))
               )
     (if (setq lst(dwgru-geom-inters-circle-line P1 P2 Pc R))
       (progn
       (princ " ** пересекаются **")
       (foreach xx lst
       (command "_.LINE" "_none" P1 "_none" xx "")
       )  
       )
       (princ " ** мимо **")
       )
     )
   )
  )