dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Библиотека функций > DwgRuLispLib: Геометрия. Треугольник

DwgRuLispLib: Геометрия. Треугольник

Версия для печати
 
Ответ
Перейти к новому Перейти к новому  
Опции темы Поиск в этой теме
Непрочитано 07.12.2007, 18:17 #1
DwgRuLispLib: Геометрия. Треугольник
VVA
 
Инженер LISP
 
Минск
Регистрация: 11.05.2005
Сообщений: 6,738
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™

VVA вне форума Вставить имя
dwgru-geom-triangle - Геометрические вычисления сторон и углов треугольника.
В качестве параметров передается список длин сторон и значений углов в радианах треугольника. Вместо неизвестных значений указываем nil. Возвращается список со всеми вычисленными значениями параметров треугольника или nil в случае ошибки.
Для прямоугольных треугольников min 2 стороны или 1 сторона и 1 угол
Для непрямоугольных: min 3 стороны, 2 стороны и 1 угол, 1 сторона и 2 угла

Используются тригонометрические библиотеки
http://dwg.ru/f/showthread.php?t=15677

Код:
[Выделить все] 
;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-geom-triangle
;;; *
;;; * Геометрические вычисления сторон и углов треугольника
;;; *
;;; * Автор Terry Cadd 
;;; *
;;; * Текст функций взят http://www.theswamp.org/index.php?topic=15698.0
;;; *
;;; * 06/12/2007 Версия 0001. Редакция Владимир Азарко (VVA)
;;; ************************************************************************
 
(defun dwgru-geom-triangle (s1 s2 s3 a b c /  e1 e2 e3 e4 e5 e6 j k negative passed)
;;; Вчисляет стороны и углы треугольника 
;;; Параметры:                    |                 /\
;;;   s1 = Сторона s1             |\               /a \
;;;   s2 = Сторона s2             |a\             /    \
;;;   s3 = Сторона s3          s2 |  \ s3     s2 /      \ s3
;;;   a = Угол a в радианах       |   \         /        \
;;;   b = Угол b в радианах       |c__b\       /c________b\
;;;   c = Угол c в радианах         s1              s1
;;; Углы a, b, c противоположны  сторонам s1, s2, s3 соответственно
;;; В качестве аргументов передаются соответствующие значения или nil, если оно неизвестно
;;; Минимально необходимые параметры:
;;;Для прямоугольных треугольников 2 стороны или 1 сторона и 1 угол
;;;Для непрямоугольных: 3 стороны, 2 стороны и 1 угол, 1 сторона и 2 угла
 
;;;  
;;; Использует функцию библиотеки
;;;                      _dwgru-trigon-acos
;;;                      _dwgru-trigon-asin
;;;                      _dwgru-trigon-tan
;;; http://dwg.ru/f/showthread.php?t=15677
;;;Возвращает список параметров прямоуголика или nil в случае ошибки
;;; Первый аргумент всегда nil
;;;    ?  s1   s2  s3    a       b        c
;;;    0  1     2   3    4       5        6
;;; '(nil 3.0 4.0 5.0 0.643501 0.927295 1.5708)
;;; Пример
;|  
(dwgru-geom-triangle 3 nil nil 0.643501 nil nil) ;_Результат (nil 3.0 4.0 5.0 0.643501 0.927295 1.5708)
|;
;;;    Использование
       ;В функцию передаются
 
;;;  
;;; Оригинальный текст
;;;-------------------------------------------------------------------------------
;;; tri - Calculates the sides and angles of a triangle
;;; Arguments: 6             |                 /\
;;;   s1 = Side s1           |\               /a \
;;;   s2 = Side s2           |a\             /    \
;;;   s3 = Side s3        s2 |  \ s3     s2 /      \ s3
;;;   a = Angle a radians    |   \         /        \
;;;   b = Angle b radians    |c__b\       /c________b\
;;;   c = Angle c radians      s1              s1
;;; Syntax example: (tri 3 ? ? 0.643501 ? ?);where ? = nil
;;; Returns: (list nil 3.0 4.0 5.0 0.643501 0.927295 1.5708);nth 1 based list
;;; Note: For right triangles only supply the argument values for 2 sides, or
;;; 1 side and 1 angle. Use ? or nil for the Angle c argument value. For oblique
;;; triangles only supply argument values for 3 sides, or 2 sides and 1 angle,
;;; or 1 side and 2 angles.
;;; Programming example usages:
;;; (setq Side2 (nth 2 (tri 3 ? ? 0.643501 ? ?))) = 4.0
;;; (setq AngleB (nth 5 (tri 3 ? ? 0.643501 ? ?))) = 0.927295
;;;-------------------------------------------------------------------------------
 
(if (vl-catch-all-error-p
      (vl-catch-all-apply '(lambda()
  (if (= (type s1)'INT)(setq s1 (float s1))) (if (<= s1 0)(setq s1 nil))
  (if (= (type s2)'INT)(setq s2 (float s2))) (if (<= s2 0)(setq s2 nil))
  (if (= (type s3)'INT)(setq s3 (float s3))) (if (<= s3 0)(setq s3 nil))
  (if (= (type a)'INT)(setq a (float a))) (if (<= a 0)(setq a nil))
  (if (= (type b)'INT)(setq b (float b))) (if (<= b 0)(setq b nil))
  (if (= (type c)'INT)(setq c (float c))) (if (<= c 0)(setq c nil))
  (setq e1 s1 e2 s2 e3 s3 e4 a e5 b e6 c passed t)
  (cond
    ((and (= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(/= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq a (atan (/ s1 s2)) c (* pi 0.5) b (- c a) s3 (/ s1 (sin a)))
    );case s1 s2
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq a (_dwgru-trigon-acos (/ s2 s3)) c (* pi 0.5) b (- c a) s1 (* s2 (_dwgru-trigon-tan a)))
    );case s2 s3
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq b (_dwgru-trigon-acos (/ s1 s3)) c (* pi 0.5) a (- c b) s2 (* s3 (sin b)))
    );case s1 s3
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(/= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq c (* pi 0.5) b (- c a) s2 (/ s1 (_dwgru-trigon-tan a)) s3 (/ s1 (sin a)))
    );case s1 a
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(/= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq c (* pi 0.5) a (- c b) s2 (* s1 (_dwgru-trigon-tan b)) s3 (/ s1 (cos b)))
    );case s1 b
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq c (* pi 0.5) b (- c a) s1 (* s2 (_dwgru-trigon-tan a)) s3 (/ s2 (cos a)))
    );case s2 a
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq c (* pi 0.5) a (- c b) s1 (/ s2 (_dwgru-trigon-tan b)) s3 (/ s2 (sin b)))
    );case s2 b
    ((and (/= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq c (* pi 0.5) b (- c a) s1 (* s3 (sin a)) s2 (* s3 (cos a)))
    );case s3 a
    ((and (/= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq c (* pi 0.5) a (- c b) s1 (* s3 (cos b)) s2 (* s3 (sin b)))
    );case s3 b
    ((and (= (type s1)'REAL)(= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq j (/ (+ s1 s2 s3) 2.0) k (sqrt (/ (* (- j s1)(- j s2)(- j s3)) j)) a (* 2 (atan (/ k (- j s1)))) b (* 2 (atan (/ k (- j s2)))) c (- pi (+ a b)))
    );case s1 s2 s3
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(/= (type s3)'REAL)(= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq c (- pi (+ a b)) s2 (/ (* s1 (sin b)) (sin a)) s3 (/ (* s1 (sin c)) (sin a)))
    );case s1 a b
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(= (type c)'REAL))
      (setq a (- pi (+ b c)) s1 (/ (* s2 (sin a)) (sin b)) s3 (/ (* s2 (sin c)) (sin b)))
    );case s2 b c
    ((and (/= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(= (type c)'REAL))
      (setq b (- pi (+ a c)) s1 (/ (* s3 (sin a)) (sin c)) s2 (/ (* s3 (sin b)) (sin c)))
    );case s3 a c
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(/= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(= (type c)'REAL))
      (setq b (- pi (+ a c)) s2 (/ (* s1 (sin b)) (sin a)) s3 (/ (* s1 (sin c)) (sin a)))
    );case s1 a c
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq c (- pi (+ a b)) s1 (/ (* s2 (sin a)) (sin b)) s3 (/ (* s2 (sin c)) (sin b)))
    );case s2 a b
    ((and (/= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(= (type c)'REAL))
      (setq a (- pi (+ b c)) s1 (/ (* s3 (sin a)) (sin c)) s2 (/ (* s3 (sin b)) (sin c)))
    );case s3 b c
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(/= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(= (type c)'REAL))
      (setq a (- pi (+ b c)) s2 (/ (* s1 (sin b)) (sin a)) s3 (/ (* s1 (sin c)) (sin a)))
    );case s1 b c
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(= (type c)'REAL))
      (setq b (- pi (+ a c)) s1 (/ (* s2 (sin a)) (sin b)) s3 (/ (* s2 (sin c)) (sin b)))
    );case s2 a c
    ((and (/= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq c (- pi (+ a b)) s1 (/ (* s3 (sin a)) (sin c)) s2 (/ (* s3 (sin b)) (sin c)))
    );case s3 a b
    ((and (= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(/= (type a)'REAL)(/= (type b)'REAL)(= (type c)'REAL))
      (setq a (atan (/ (* s1 (sin c)) (- s2 (* s1 (cos c))))) b (- pi (+ a c)) s3 (/ (* s1 (sin c)) (sin a)))
    );case s1 s2 c
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq b (atan (/ (* s2 (sin a)) (- s3 (* s2 (cos a))))) c (- pi (+ a b)) s1 (/ (* s2 (sin a)) (sin b)))
    );case s2 s3 a
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq c (atan (/ (* s3 (sin b)) (- s1 (* s3 (cos b))))) a (- pi (+ b c)) s2 (/ (* s3 (sin b)) (sin c)))
    );case s1 s3 b
    ((and (= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq b (_dwgru-trigon-asin (/ (* s2 (sin a)) s1)) c (- pi (+ a b)) s3 (/ (* s1 (sin c)) (sin a)))
    );case s1 s2 a
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq c (_dwgru-trigon-asin (/ (* s3 (sin b)) s2)) a (- pi (+ b c)) s1 (/ (* s2 (sin a)) (sin b)))
    );case s2 s3 b
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(/= (type b)'REAL)(= (type c)'REAL))
      (setq a (_dwgru-trigon-asin (/ (* s1 (sin c)) s3)) b (- pi (+ a c)) s2 (/ (* s3 (sin b)) (sin c)))
    );case s1 s3 c
    ((and (= (type s1)'REAL)(= (type s2)'REAL)(/= (type s3)'REAL)(/= (type a)'REAL)(= (type b)'REAL)(/= (type c)'REAL))
      (setq a (_dwgru-trigon-asin (/ (* s1 (sin b)) s2)) c (- pi (+ a b)) s3 (/ (* s2 (sin c)) (sin b)))
    );case s1 s2 b
    ((and (/= (type s1)'REAL)(= (type s2)'REAL)(= (type s3)'REAL)(/= (type a)'REAL)(/= (type b)'REAL)(= (type c)'REAL))
      (setq b (_dwgru-trigon-asin (/ (* s2 (sin c)) s3)) a (- pi (+ b c)) s1 (/ (* s3 (sin a)) (sin c)))
    );case s2 s3 c
    ((and (= (type s1)'REAL)(/= (type s2)'REAL)(= (type s3)'REAL)(= (type a)'REAL)(/= (type b)'REAL)(/= (type c)'REAL))
      (setq c (_dwgru-trigon-asin (/ (* s3 (sin a)) s1)) b (- pi (+ a c)) s2 (/ (* s1 (sin b)) (sin a)))
    );case s1 s3 a
    (t (setq passed nil)
    );case errors
  );cond
  (foreach item (list s1 s2 s3 a b c)
    (if (= (type item)'REAL) (if (<= Item 0)(setq negative t)))
  );foreach
  (if (or (not passed) negative)
    (progn
      ;;;Comment 07.12.2007 VVA
      ;|
      (textscr)(princ "\ntri error: (tri ")(princ e1)(princ " ")(princ e2)(princ " ")(princ e3)(princ " ")(princ e4)(princ " ")(princ e5)(princ " ")(princ e6)(princ ")")
      (if negative (progn (princ "\nResults: s1 = ")(princ s1)(princ ", s2 = ")(princ s2)(princ ", s3 = ")(princ s3)(princ "\n         a = ")(princ a)(princ ", b = ")(princ b)(princ ", c = ")(princ c)))
      (princ "\nOnly 2 or 3 valid arguments can be passed to tri function.\n")
      (princ "\ntri - Calculates the sides and angles of a triangle")
      (princ "\nArguments: 6             |\\                /\\ ");Text display depends on users font
      (princ "\n  s1 = Side s1           |a\\              /a \\ ")
      (princ "\n  s2 = Side s2           |  \\            /    \\ ")
      (princ "\n  s3 = Side s3        s2 |   \\ s3    s2 /      \\ s3")
      (princ "\n  a = Angle a radians    |    \\        /        \\ ")
      (princ "\n  b = Angle b radians    |c___b\\      /c________b\\ ")
      (princ "\n  c = Angle c radians      s1              s1")
      (princ "\nSyntax example: (tri 3 ? ? 0.643501 ? ?);where ? = nil")
      (princ "\nReturns: (list nil 3.0 4.0 5.0 0.643501 0.927295 1.5708)")
      (princ "\nNote: For right triangles only supply the argument values for 2 sides,")
      (princ "\nor 1 side and 1 angle. Use ? or nil for the Angle c argument value.")
      (princ "\nFor oblique triangles only supply argument values for 3 sides,")
      (princ "\nor 2 sides and 1 angle, or 1 side and 2 angles.")
      ;;; (exit)  ;_ 07.12.2007 Comment VVA
      |;
      (setq ret nil)
    );progn
    (setq ret (list nil s1 s2 s3 a b c)) ;_ 07.12.2007 Move by VVA
  );if
)
        )
      )
      (setq ret nil)
  )
  ;;; (list nil s1 s2 s3 a b c);nth 1 based list ;_ 07.12.2007 Comment VVA
  ret
);defun tri

Вложения
Тип файла: lsp dwgru-geom-triangle.lsp (12.2 Кб, 272 просмотров)

__________________
Как использовать код на Лиспе читаем здесь
Просмотров: 10423
 
Автор темы   Непрочитано 07.12.2007, 18:18
#2
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,738
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™

Ну и небольшой примерчик. Нарисуем треугольник из отрезков. Образмерим стороны и углы.
Код:
[Выделить все] 
(defun C:TEST ()
  (if
  (and
    (princ "\nВыберите 1-й отрезок ")
    (setq ss nil ss (ssget "_:S:E" '((0 . "LINE"))))
    (setq ent1 (ssname ss 0))
    (princ "\nВыберите 2-й отрезок ")
    (setq ss nil ss  (ssget "_:S:E" '((0 . "LINE"))))
    (setq ent2 (ssname ss 0))
    (princ "\nВыберите 3-й отрезок ")
    (setq ss nil ss  (ssget "_:S:E" '((0 . "LINE"))))
    (setq ent3 (ssname ss 0))
    )
  (progn
    (if
    (setq lst
           (dwgru-geom-triangle
             (distance (cdr(assoc 10 (entget ent1)))
                       (cdr(assoc 11 (entget ent1)))
                       )
             (distance (cdr(assoc 10 (entget ent2)))
                       (cdr(assoc 11 (entget ent2)))
                       )
             (distance (cdr(assoc 10 (entget ent3)))
                       (cdr(assoc 11 (entget ent3)))
                       )
             nil
             nil
             nil
             )
          )
 
    (progn
      (princ "\nДлинна 1-й стороны - ")(princ (nth 1 lst))
      (princ "\nДлинна 2-й стороны - ")(princ (nth 2 lst))
      (princ "\nДлинна 3-й стороны - ")(princ (nth 3 lst))
      (princ "\nУгол напротив 1-й стороны - ")(princ (/ (* (nth 4 lst) 180.0) pi))
      (princ "\nУгол напротив 2-й стороны - ")(princ (/ (* (nth 5 lst) 180.0) pi))
      (princ "\nУгол напротив 3-й стороны - ")(princ (/ (* (nth 6 lst) 180.0) pi))
      )
    )
  )
  (alert "Ошибка")
  )
  (princ)
  )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Библиотека функций > DwgRuLispLib: Геометрия. Треугольник

РЕВЕРС. Автоматическая пакетная печать множества рамок (форматов) из пространства модели и листов
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
DwgRuLispLib: Генератор случайных чисел VVA Библиотека функций 16 11.03.2013 21:21
DwgRuLispLib: Модификация ename-представлений примитивов Кулик Алексей aka kpblc Библиотека функций 6 07.12.2007 13:55
Pасположить треугольник в 3D пространстве при помощи 3dalign Baires AutoCAD 7 24.08.2006 06:36
Как начертить треугольник по трем известным сторонам strelock AutoCAD 10 16.04.2006 22:17

Обратная связь - DWG.RU - Архив - Вверх

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||