[DsC]

Товарищи профессианали ЛИСПа. Пожалуйста помогите с курсовой. Лекции нам читали гадко и ничего вообще не понятно как писать. Но по формулировке задачи кажется, что программа должна быть не сложной, особенно для профи.
Вот формулировка задания:
На экране пользователем задается ломаная (командой LINE), состоящая из отрезков двух разных цветов. Написать программу, сглаживающую ломаную дугами окружностей трех возможных радиусов, определенных пользователем, в зависимости от цвета отрезков, составляющих угол (лишние кусочки отрезков ломаной после сглаживания должны быть удалены). Например, используются отрезки двух цветов: красные и синие. Пользователь задал три радиуса: Rl, R2, R3. Если угол составляют красные отрезки, необходимо сгладить его дугой радиуса R1, если угол составляют красный и синий отрезки - радиусом R2, если синие отрезка - радиусом R3. Замечание: при задании пользователем радиусов сопряжения необходимо проводить анализ их допустимости.

Если кому-то задачка покажется простой, напишите программку,аа...очень прошу=)

[T-Yoke]

Сообщение от DsC Т...по формулировке задачи кажется, что программа должна быть не сложной, особенно для профи. Вот формулировка задания: На экране пользователем задается ломаная (командой LINE), состоящая из отрезков двух разных цветов. Написать программу, сглаживающую ломаную дугами окружностей трех возможных радиусов, определенных пользователем, в зависимости от цвета отрезков, составляющих угол (лишние кусочки отрезков ломаной после сглаживания должны быть удалены). Например, используются отрезки двух цветов: красные и синие. Пользователь задал три радиуса: Rl, R2, R3. Если угол составляют красные отрезки, необходимо сгладить его дугой радиуса R1, если угол составляют красный и синий отрезки - радиусом R2, если синие отрезка - радиусом R3. Замечание: при задании пользователем радиусов сопряжения необходимо проводить анализ их допустимости. ...

И вот на такой бредятине учат наших студентов. Ужас!

[Profan]

Для DsC.

Но по формулировке задачи кажется, что программа должна быть не сложной, особенно для профи.

А ведь профи не возьмется за какую попало задачу. Нужен хоть какой-нибудь мало-мальский смысл. Я вот еще далеко не профи, однако подобная задача вызывает у меня недоумение своей абстрактностью, неочевидностью прикладного назначения.

[Олег К.]

Да-а, ужос чему учат. Помнится нам при изучении АвтоКАДа задали расчитать и начертить (скриптом или ЛИСПом) П-образный компенсатор в три линии со всеми размерами. И называлось это всего лишь типовым расчетом, хотя специальность совсем не программистская.

>> DsC
Честно скажу, что за такое не возьмусь, но пару рекомендаций дам (а то гуру сейчас появятся, такое в свой адрес услышиш ).
1. Главное. Правильная постановка задачи уже является половиной её решения.
2. Каким образом задаются отрезки? Команда LINE не прерывается, или это отдельные отрезки в произвольных местах?
3. Как задаётся цвет? Для каждого отрезка отдельно через свойства или по слою (отрезки на разных слоях)?
4. Как должен осуществляться выбор отрезков в программе? Наверное должно быть похоже на работу команды FILLET. Вот отсюда и пляши.

[Кулик Алексей aka kpblc]

ИМХО: вся программа сводится к (command "_.fillet") с установлением радиуса. А радиус определять через (cond). Например, как-то так:

Код:

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

(defun test (/ *error* ent1 ent2 r1 r2 r3 r filletrad)
  (defun *error* (msg)
    (if filletrad
      (setvar "filletrad" filletrad)
      ) ;_ end of if
    (princ msg)
    (princ)
    ) ;_ end of defun

  (if
    (and (= (type (setq r1 (vl-catch-all-apply
                             '(lambda () (getreal "\nРадиус 1 <Отмена> : "))
                             ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'real
            ) ;_ end of =
         (= (type (setq r2 (vl-catch-all-apply
                             '(lambda () (getreal "\nРадиус 2 <Отмена> : "))
                             ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'real
            ) ;_ end of =
         (= (type (setq r3 (vl-catch-all-apply
                             '(lambda () (getreal "\nРадиус 3 <Отмена> : "))
                             ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'real
            ) ;_ end of =
         (= (type (setq ent1 (vl-catch-all-apply
                               '(lambda () (car (entsel "\nОтрезок 1 <Отмена> : ")))
                               ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'ename
            ) ;_ end of =
         (= (cdr (assoc 0 (entget ent1))) "LINE")
         (= (type (setq ent2 (vl-catch-all-apply
                               '(lambda () (car (entsel "\nОтрезок 2 <Отмена> : ")))
                               ) ;_ end of vl-catch-all-apply
                        ) ;_ end of setq
                  ) ;_ end of type
            'ename
            ) ;_ end of =
         (= (cdr (assoc 0 (entget ent2))) "LINE")
         (setq r (cond
                   ((and (= (cdr (assoc 62 (entget ent1))) 1)
                         (= (cdr (assoc 62 (entget ent2))) 1)
                         ) ;_ end of and
                    r1
                    )
                   ((or (and (= (cdr (assoc 62 (entget ent1))) 5)
                             (= (cdr (assoc 62 (entget ent2))) 1)
                             ) ;_ end of and
                        (and (= (cdr (assoc 62 (entget ent1))) 1)
                             (= (cdr (assoc 62 (entget ent2))) 5)
                             ) ;_ end of and
                        ) ;_ end of or
                    r2
                    )
                   ((and (= (cdr (assoc 62 (entget ent1))) 5)
                         (= (cdr (assoc 62 (entget ent2))) 5)
                         ) ;_ end of and
                    r3
                    )
                   (t nil)
                   ) ;_ end of cond
               ) ;_ end of setq
         ) ;_ end of and
     (progn
       (setq filletrad (getvar "filletrad"))
       (setvar "filletrad" r)
       (command "_.fillet" ent1 ent2)
       (setvar "filletrad" filletrad)
       ) ;_ end of progn
     ) ;_ end of if
  ) ;_ end of defun

Опаньки, опередили И, между прочим, все верно сказали. В моем коде никаких проверок (кроме как на ошибки ввода) нет

[Елпанов Евгений]

>Profan
Прикладное значение, всегда можно найти...
Как пример - трубопровод, если обозначать цветами, трубы различных диаметров, то и сопряжения в углах будут подбираться по похожему алгоритму.

>DsC
А задачка на плоскости или в объеме?

[Profan]

Ну, значит, (с горестным вздохом) Алексей Кулик и Евгений Елпанов еще не профи.
А если серьезно, Алексей, ты уверен, что код будет понятен DsC?
Вот и Евгений задает такой вопрос, что кажется, будто задача для него слишком проста, не интересна, хочется усложнить.

[Елпанов Евгений]

Сообщение от Profan Вот и Евгений задает такой вопрос, что кажется, будто задача для него слишком проста, не интересна, хочется усложнить.

Я принципиально не использую ком строку, т.е. если бы взялся, написал бы все на чистой математике...

[Profan]

Подумал немного над этой задачей. И пришел к выводу, что основную трудность для меня составляет определение максимально возможного радиуса сопряжения двух отрезков в зависимости от их длины и угла между ними. Решалась ли такая задача кем-нибудь? Поиском не нашел пока ничего. Но стало интересно.

[Елпанов Евгений]

Сообщение от Profan Подумал немного над этой задачей. И пришел к выводу, что основную трудность для меня составляет определение максимально возможного радиуса сопряжения двух отрезков в зависимости от их длины и угла между ними. Решалась ли такая задача кем-нибудь? Поиском не нашел пока ничего. Но стало интересно.

Это не сложно, если нарисовать...
Короче, есть два отрезка и они объединены сопрягающей дугой. Что можно сказать о дуге? Во первых, ее центр удален от обоих отрезков на радиус дуги, во вторых, ее угол, равен углу между отрезками, в третьих, начальный и конечные углы этой дуги, перпендикулярны отрезкам. Это только мысли в слух...

PS. мной эта задача решалась..

[Олег К.]

Главное, чтобы код был понятен преподавателю .

Позволю себе внести некоторые добавки в предложенный код.
При определении цвета:

Код:

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

...
(setq r (cond
                   ((and (= (if (assoc 62 (entget ent1))
	                           (cdr (assoc 62 (entget ent1)))
	                           (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 (entget ent1))))))
	                        )
                            1)
                           (= (if (assoc 62 (entget ent2))
	                           (cdr (assoc 62 (entget ent2)))
	                           (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 (entget ent2))))))
	                       )
                           1)
                         ) ;_ end of and
                    r1
                    ) ...

И в качестве украшательства:

Код:

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

(if (vl-cmdf "_.fillet" ent1 ent2)
	(cond ; (раскраска дуги)
	  ((= r r1)
	     (setq fillarc (entget (entlast)))
	     (if (assoc 62 fillarc)
	       (entmod (subst (cons 62 1) (assoc 62 fillarc) fillarc))
	       (entmod (append fillarc (list (cons 62 1))))
	     )
	  ) ; r=r1
	  ((= r r2)
	     (setq fillarc (entget (entlast)))
	     (if (assoc 62 fillarc)
	       (entmod (subst (cons 62 6) (assoc 62 fillarc) fillarc))
	       (entmod (append fillarc (list (cons 62 6))))
	     )
	  ) ; r=r2
	  ((= r r3)
	     (setq fillarc (entget (entlast)))
	     (if (assoc 62 fillarc)
	       (entmod (subst (cons 62 5) (assoc 62 fillarc) fillarc))
	       (entmod (append fillarc (list (cons 62 5))))
	     )
	  ) ; r=r3
	) ; cond(раскраска дуги)
	(alert "Отрезки не могут быть сопряжены")
      ) ; if(command)

По поводу математики. Если я правильно понимаю, получив точку пересечения отрезков, отступаем от неё на радиус по каждому из отрезков - получаем точки пересечения отрезков с дугой сопряжения (= нач и кон точки дуги). Значит максимальный радиус сопряжения - это расстояние от точки пересечения отрезков до самой дальней точки наиболее короткого отрезка? (вот же выразился, надеюсь без картинки понятно будет).

[Кулик Алексей aka kpblc]

(command bla-bla-bla) вернет nil в любом случае. Так что "украшательства" не получится.

[Profan]

Точно:

Код:

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

 
Команда: (command bla-bla-bla)
*Прервано*
nil

[Олег К.]

М-да, действительно . Тогда заменим (command ...) на (vl-cmdf ...).

[Кулик Алексей aka kpblc]

Profan, (command "_.fillet" ent1 ent2) вернет nil в любом случае.
(в сторону): А автора не видно и не слышно

[Олег К.]

А автора не видно и не слышно

Сгорел?

[DsC]

Автор вот он =)
Не ожидал такого количества ответов.
Хочется ответить всем и каждому, но вот только некоторые поправки:
Когда я еще пытался разобраться сам, то преподавательниЦА сказала:"Как задачу поставишь, так и будешь решать" и я подумал на счет того как задавать исходный чертеж...Чтоб не мучаться с поиском последовательных отрезков, создавать их каждый раз программно случайным образом последовательными LINEами со случайной длинной(в адекватных пределах)/ со случайными смещениями очередного конца и со случайным цветом...У пользователя спрашивать только количество отрезков и радиусы...на счет радиусов,кстати, ничего сказать не многу =(
Код действительно непонятен почти =( Преподавательница тоже не профи(она специалист широкого профиля - чего тока не преподает!!! и как следствие нормально не знает ничего) так что и ей он будет непонятен скорее всего.
Задача решается на плоскости конечно же...
На счет применимости данной задачи к жизни могу сказать одно - НИ ОДНА лабораторка ни по одному языку программирования не имела нормального жизненного приложения! Это меня тоже жутко бесит!
Все еще с надеждой жду рабочего варианта...

[Regby]

А где вас такому учат? И по какому предмету?

[Олег К.]

Ага, коллега. Мы тоже вместе с преподом AutoCAD изучали.
Теперь без шуток.
Разве предложенный вариант не рабочий?
Уже нужна вторая программа для рисования случайных отрезков? Может проще один раз нарисовать нужные отрезки, сохранить этот файл и работать с ним.

>> Кулик Алексей aka kpblc
Кто-то говорил про китайских мудрецов и удочки.

[DsC]

Сообщение от Regby А где вас такому учат? И по какому предмету?

Московский институт электроники и математики =)
Предмет...чтоб не обмануть-то...официально кажется "Языки программирования искусственнного интеллекта"

[DsC]

Сообщение от Кулик Алексей aka kpblc ИМХО: вся программа сводится к (command "_.fillet") с установлением радиуса. А радиус определять через (cond). Например, как-то так: Код: [Выделить все] (defun test (/ *error* ent1 ent2 r1 r2 r3 r filletrad) (defun *error* (msg) (if filletrad (setvar "filletrad" filletrad) ) ;_ end of if (princ msg) (princ) ) ;_ end of defun (if (and (= (type (setq r1 (vl-catch-all-apply '(lambda () (getreal "\nРадиус 1 <Отмена> : ")) ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of type 'real ) ;_ end of = (= (type (setq r2 (vl-catch-all-apply '(lambda () (getreal "\nРадиус 2 <Отмена> : ")) ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of type 'real ) ;_ end of = (= (type (setq r3 (vl-catch-all-apply '(lambda () (getreal "\nРадиус 3 <Отмена> : ")) ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of type 'real ) ;_ end of = (= (type (setq ent1 (vl-catch-all-apply '(lambda () (car (entsel "\nОтрезок 1 <Отмена> : "))) ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of type 'ename ) ;_ end of = (= (cdr (assoc 0 (entget ent1))) "LINE") (= (type (setq ent2 (vl-catch-all-apply '(lambda () (car (entsel "\nОтрезок 2 <Отмена> : "))) ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of type 'ename ) ;_ end of = (= (cdr (assoc 0 (entget ent2))) "LINE") (setq r (cond ((and (= (cdr (assoc 62 (entget ent1))) 1) (= (cdr (assoc 62 (entget ent2))) 1) ) ;_ end of and r1 ) ((or (and (= (cdr (assoc 62 (entget ent1))) 5) (= (cdr (assoc 62 (entget ent2))) 1) ) ;_ end of and (and (= (cdr (assoc 62 (entget ent1))) 1) (= (cdr (assoc 62 (entget ent2))) 5) ) ;_ end of and ) ;_ end of or r2 ) ((and (= (cdr (assoc 62 (entget ent1))) 5) (= (cdr (assoc 62 (entget ent2))) 5) ) ;_ end of and r3 ) (t nil) ) ;_ end of cond ) ;_ end of setq ) ;_ end of and (progn (setq filletrad (getvar "filletrad")) (setvar "filletrad" r) (command "_.fillet" ent1 ent2) (setvar "filletrad" filletrad) ) ;_ end of progn ) ;_ end of if ) ;_ end of defun Опаньки, опередили И, между прочим, все верно сказали. В моем коде никаких проверок (кроме как на ошибки ввода) нет

Всё, я переучился =(( ...задам наверное самый идиотский вопрос...Запустил я эту программку, ввел радиусы, а как ввести линии?

[Олег К.]

А что после радиусов программа запрашивает?
У меня вот так:

Command: (TEST) Радиус 1 <Отмена> : 10 Радиус 2 <Отмена> : 15 Радиус 3 <Отмена> : 20 Отрезок 1 <Отмена> : Отрезок 2 <Отмена> : _.fillet Current settings: Mode = TRIM, Radius = 15.00 Select first object or [uNdo/Polyline/Radius/Trim/mUltiple]: Select second object or shift-select to apply corner: Command: 0.0

Так, о самом главном забыли! Версия АвтоКАДа не ниже 2004-й?

[Profan]

Отрезки, видимо, заранее должны быть нарисованы.

[DsC]

Я ввел 3 радиуса - 3 числа.
Что вводить при запросе отрезка? Число, координаты(2 числа через запятую)? Или что-то еще?
Когда ввожу одно число, просит ввести второй отрезок, ввожу ещ одно число - пишет nil.
и даже когда выбираю отрезки мышью - на втором выборе пишет - nil
Автокад 2007 русский

[Profan]

Там присутсвуют такие выражения:

Код:

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

 
(entsel "\nОтрезок 1 <Отмена> : ")

Функция (entsel) предполагает выбор одиночного объекта. Лучше было бы написать так:

Код:

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

 
(entsel "\nУкажите отрезок 1 <Отмена> : ")

[DsC]

Я и указывал...При указании на первый отрезок все работает, а при втором выводит nil и более ничего не делает.

[Кулик Алексей aka kpblc]

Олег К., говорил. И буду говорить. Мне было любопытно, кто-нибудь обратит внимание или нет на нестыковочку . Думать на работе было лениво, ни фига не получалось, я разозлился и сделал код. Уж лучше так, чем на людей выплескивать

DsC, проверь координаты отрезков. Они (отрезки то бишь) должны быть нарисованы в одной плоскости.
Profan, критика принята. Но не исправлена. Оставлено на совесть автора топика

[DsC]

Я рисовал отрезки LINEом безотрыва в одной плоскости.

[fixo]

Сообщение от DsC Я рисовал отрезки LINEом безотрыва в одной плоскости.

Забудь про все и юзай это, только сначала прочитай
обязательно все комментарии:

Код:

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

(defun C:FIL()
  
;; локальная функция задания переменных по стандартам
  (defun restore ()
      (setvar "cmdecho" 1)
  (setvar "osmode" 703)
    )
;; локальная функция вычисляет угол между
;; 2-мя линиями независимо от направления
;; их рисования
(defun getang (a1 a2)
  (cond
      ((> a1 (+ a2 pi))
        (setq a2 (+ a2 (* 2 pi)))
      )
      ((> a2 (+ a1 pi))
        (setq a1 (+ a1 (* 2 pi)))
      )
    )
    (- a2 a1)
)
;; локальная функция получения элемента
;; по ключу из списка точечных пар
(defun dxf (key lst)
  (cdr (assoc key lst))
       )

;; ===============основная часть====================;;
  
;; подавляем эхо-вывод командной строки
(setvar "cmdecho" 0)
;; подавляем привязки
  (setvar "osmode" 0)
;; задаем радиусы  
(setq r1 (getdist "\nRadius number 1: ")
      r2 (getdist "\nRadius number 2: ")
      r3 (getdist "\nRadius number 3: ")
      )
;; задаем цвет первой линии либо 1 либо 5, другие цвета не введешь:
(while (not
	 (and
	   (setq col (getstring "\nColor (1 or 5 only): "))
	   (or (eq col "1")
	       (eq col "5"))))
  )
;; устанавливаем текущий цвет для рисунка  
(setvar "cecolor" col)

;; рисуем первую линию  
(command "line" pause pause "")
;; создаем пустой набор выбора  
(setq ss1 (ssadd))

(setq ln1 (entlast); определяем последний нарисованный примитив (1-я линия)
      el1 (entget ln1); получаем список примитива
      ;; извлекаем данные из списка примитива
      col1 (dxf 62 el1); получаем цвет
      sp1 (dxf 10 el1); получаем начальную точку
      ep1 (dxf 11 el1); получаем конечную точку
      d1 (distance sp1 ep1); определяем длину линии
      a1 (angle ep1 sp1) ; определяем угол линии из !конечной! точки
      )
;; добавляем 1-ю линию в первый набор  
(ssadd ln1 ss1)
  
;; задаем цвет второй линии либо 1 либо 5, другие цвета не введешь:
(while (not
	 (and
	   (setq col (getstring "\nColor (1 or 5 only): "))
	   (or (eq col "1")
	       (eq col "5"))))
  )
;; устанавливаем текущий цвет для рисунка    
(setvar "cecolor" col)
;; рисуем вторую линию  
(command "line" (getvar "lastpoint") pause "")
;; создаем второй пустой набор выбора  
(setq ss2 (ssadd))
    
(setq ln2 (entlast); определяем последний нарисованный примитив (2-я линия)
      el2 (entget ln2); получаем список примитива
      ;; извлекаем данные из списка примитива
      col2 (dxf 62 el2); получаем цвет
      sp2 (dxf 10 el2); получаем начальную точку
      ep2 (dxf 11 el2); получаем конечную точку
      d2 (distance sp2 ep2); определяем длину линии
      a2 (angle sp2 ep2) ; определяем угол линии из !начальной! точки
      )
;; добавляем 2-ю линию во второй набор    
(ssadd ln2 ss2)
;; вычисляем угол заключенный между линиями
(setq ang (getang a1 a2)
      ;; берем половину угла для вычислений
      ang (/ ang 2.)
      )
;; определяем наименьшую длину из 2-х линий
(setq mind (min d1 d2))
;; вычисляем через котангенс максимально возможный радиус
(setq maxr (abs (/ (* (cos ang) mind)(sin ang))))
;; сглаживаем линии в зависимости от полученных данных:
(cond ((and (= 1 col1)(= 1 col2)); обе линиии красного цвета
       (princ "\nBoth lines are red")
       (if (> r1 maxr); если радиус вне допустимого значения - остановка программы
	 (progn
	 (alert "Radius is greater than permissible value\n\tProgramm stopped")
	 (exit)(princ)
	 )
	 (progn
	   (setvar "filletrad" r1)
	   (command "fillet" ss1 ss2)))
       )
      ((and (= 5 col1)(= 5 col2)); обе линиии синего цвета
       (princ "\nBoth lines are blue")
       (if (> r3 maxr)
	 (progn
	 (alert "Radius is greater than permissible value\n\tProgramm stopped")
	 (exit)(princ)
	 )
	 (progn
	   (setvar "filletrad" r3)
	   (command "fillet" ss1 ss2)))
       )
      ((or (and (= 1 col1)(= 5 col2))(and (= 5 col1)(= 1 col2))); одна красная - другая синяя
       (princ "\nThe lines are mix colored")
       (if (> r2 maxr)
	 (progn
	 (alert "Radius is greater than permissible value\n\tProgramm stopped")
	 (exit)(princ)
	 )
	 (progn
	   (setvar "filletrad" r2)
	   (command "fillet" ss1 ss2))))
      )
  ;; задаем системные переменные по своим стандартам
  (restore)
  ;; тихий выход из программы:
       (princ)
  )
(C:fil);автозапуск (по ситуации)

~'J'~

[DsC]

ОРГОМНЕЙШЕЕ СПАСИБО!Оно работает! Только на сколько я понял не совсем так как хотелось бы...ну то есть не так как в задании.
У меня она запросила 3 радиуса, 2 цвета и 2 отрезка. сгладила все замечательно и на этом завершила свою работу. А как бы ее заставить работать по циклу - несколько проходов?! чтоб обрататывать именно кривую, а не 2 отрезка только!
P.S. Не хочется конечно совсем наглеть, но в задании написано ВНАЧАЛЕ РИСОВАТЬ кривую, а потом ее обрабатывать...если это не потребут сильной переделки того что уже работает...буду безумно благодарен =) В противном случае попытаюсь сдать то что есть...ведь умение сдавать - это как и программирование - тоже искусство =)

[Александр Бауск]

Уморили.

[fixo]

Сообщение от DsC ОРГОМНЕЙШЕЕ СПАСИБО!Оно работает! Только на сколько я понял не совсем так как хотелось бы...ну то есть не так как в задании. У меня она запросила 3 радиуса, 2 цвета и 2 отрезка. сгладила все замечательно и на этом завершила свою работу. А как бы ее заставить работать по циклу - несколько проходов?! чтоб обрататывать именно кривую, а не 2 отрезка только! P.S. Не хочется конечно совсем наглеть, но в задании написано ВНАЧАЛЕ РИСОВАТЬ кривую, а потом ее обрабатывать...если это не потребут сильной переделки того что уже работает...буду безумно благодарен =) В противном случае попытаюсь сдать то что есть...ведь умение сдавать - это как и программирование - тоже искусство =)

Я в этих филозофиях не шибко, радуйся что я не сплю пока:

Код:

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

(defun C:FIL()
  
;; локальная функция задания переменных по стандартам
  (defun restore ()
      (setvar "cmdecho" 1)
  (setvar "osmode" 703)
    )
;; локальная функция вычисляет угол между
;; 2-мя линиями независимо от направления
;; их рисования
(defun getang (a1 a2)
  (cond
      ((> a1 (+ a2 pi))
        (setq a2 (+ a2 (* 2 pi)))
      )
      ((> a2 (+ a1 pi))
        (setq a1 (+ a1 (* 2 pi)))
      )
    )
    (- a2 a1)
)
;; локальная функция получения элемента
;; по ключу из списка точечных пар
(defun dxf (key lst)
  (cdr (assoc key lst))
       )

;; ===============основная часть====================;;
  
;; подавляем эхо-вывод командной строки
(setvar "cmdecho" 0)
;; подавляем привязки
  (setvar "osmode" 0)
;; задаем радиусы  
(setq r1 (getdist "\nRadius number 1: ")
      r2 (getdist "\nRadius number 2: ")
      r3 (getdist "\nRadius number 3: ")
      )
(setq p1 (getpoint "\nPick the starting point of line : "))
(setq p2 (getpoint p1 "\nPick the ending point : "))
;; задаем цвет первой линии либо 1 либо 5, другие цвета не введешь:
(while (not
	 (and
	   (setq col (getstring "\nColor (1 or 5 only): "))
	   (or (eq col "1")
	       (eq col "5"))))
  )
;; устанавливаем текущий цвет для рисунка  
(setvar "cecolor" col)

;; рисуем первую линию  
(command "line" p1 p2 "")
;; создаем пустой набор выбора  
(setq ss1 (ssadd))

(setq ln1 (entlast); определяем последний нарисованный примитив (1-я линия)
      el1 (entget ln1); получаем список примитива
      ;; извлекаем данные из списка примитива
      col1 (dxf 62 el1); получаем цвет
      sp1 (dxf 10 el1); получаем начальную точку
      ep1 (dxf 11 el1); получаем конечную точку
      d1 (distance sp1 ep1); определяем длину линии
      a1 (angle ep1 sp1) ; определяем угол линии из !конечной! точки
      )
;; добавляем 1-ю линию в первый набор  
(ssadd ln1 ss1)
  
(while
;; рисуем вторую линию
(setq pt (getpoint p2 "\nSpecify the next point (or press Enter to Exit): ")) 
;; задаем цвет второй линии либо 1 либо 5, другие цвета не введешь:
(while (not
	 (and
	   (setq col (getstring "\nColor (1 or 5 only): "))
	   (or (eq col "1")
	       (eq col "5"))))
  )
;; устанавливаем текущий цвет для рисунка    
(setvar "cecolor" col)
  (command "line" p2 pt "")
;; создаем второй пустой набор выбора  
(setq ss2 (ssadd))
    
(setq ln2 (entlast); определяем последний нарисованный примитив (2-я линия)
      el2 (entget ln2); получаем список примитива
      ;; извлекаем данные из списка примитива
      col2 (dxf 62 el2); получаем цвет
      sp2 (dxf 10 el2); получаем начальную точку
      ep2 (dxf 11 el2); получаем конечную точку
      d2 (distance sp2 ep2); определяем длину линии
      a2 (angle sp2 ep2) ; определяем угол линии из !начальной! точки
      )
;; добавляем 2-ю линию в первый набор    
(ssadd ln2 ss2)
;; вычисляем угол заключенный между линиями
(setq ang (getang a1 a2)
      ;; берем половину угла для вычислений
      ang (/ ang 2.)
      )
;; определяем наименьшую длину из 2-х линий
(setq mind (min d1 d2))
;; вычисляем через котангенс максимально возможный радиус
(setq maxr (abs (/ (* (cos ang) mind)(sin ang))))
;; сглаживаем линии в зависимости от полученных данных:
(cond ((and (= 1 col1)(= 1 col2)); обе линиии красного цвета
       (princ "\nBoth lines are red")
       (if (> r1 maxr); если радиус вне допустимого значения - остановка программы
	 (progn
	 (alert "Radius is greater than permissible value\n\tProgramm stopped")
	 (exit)(princ)
	 )
	 (progn
	   (setvar "filletrad" r1)
	   (command "fillet" ss1 ss2)))
       )
      ((and (= 5 col1)(= 5 col2)); обе линиии синего цвета
       (princ "\nBoth lines are blue")
       (if (> r3 maxr)
	 (progn
	 (alert "Radius is greater than permissible value\n\tProgramm stopped")
	 (exit)(princ)
	 )
	 (progn
	   (setvar "filletrad" r3)
	   (command "fillet" ss1 ss2)))
       )
      ((or (and (= 1 col1)(= 5 col2))(and (= 5 col1)(= 1 col2))); одна красная - другая синяя
       (princ "\nThe lines are mix colored")
       (if (> r2 maxr)
	 (progn
	 (alert "Radius is greater than permissible value\n\tProgramm stopped")
	 (exit)(princ)
	 )
	 (progn
	   (setvar "filletrad" r2)
	   (command "fillet" ss1 ss2))))
      )
;; меняем наборы местами
  (setq ss1 ss2)
;; менчяем точки местами
  (setq p2 pt)
  )

  ;; задаем системные переменные по своим стандартам
  (restore)
  ;; тихий выход из программы:
       (princ)
  )
(C:fil);автозапуск (по ситуации)

~'J'~

[VVA]

>DsC Если вдруг у препода стоит русский Автокад, купленный официально, то вариант Fatty работать не будет. Чтобы заработал даже у китайцев, нужно в английские названия команд в начало добавить "_"
Было
(command "fillet" ...
Должно быть
(command "_fillet"

[Кулик Алексей aka kpblc]

А чтобы заработало даже у продвинутых китайцев, надо делать
(command "_.fillet" <...>)
(точку поставить)

[DsC]

УРАА!!! СПАСИБО!! ОГРОМНОЕ ЧЕЛОВЕЧЕСКОЕ И НЕЧЕЛОВЕЧЕСКОЕ СПАСИБО ВСЕМ КТО ПОУЧАСТВОВАЛ И СЛОВОМ И ДЕЛОМ! Я ВСЕ ЭТО СДАЛ СЕГОДНЯ НА ОТЛ! Даже сам разобрался и объяснил кое-что преподавательнице =))) Гора с плеч!

[Vova]

Даже сам разобрался и объяснил кое-что преподавательнице

Ключевая фраза. Ну так остаешься на форуме навсегда или спасибом отделаешься?

[Profan]

Московский институт электроники и математики =)

А Евгений Елпанов намекал на какие-то трубопроводы. Видимо, эта программа будет применятся для гнутия проводов или извилин в мозгах.