[DsC]

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

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

[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]

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

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