[222ketti]

Помогите написать программу для построения прямоугольника через LISP - приложение
Так что бы по данным вводимыми нами в диалоговом окне(которое мы тоже программируем,и в котором мы можем задать цвет, размеры и угол поворота относительно оси Х и посмотреть вид) строился прямоугольник в AutoCAD'е

[Alan]

Сообщение от 222ketti Помогите написать программу для построения прямоугольника через LISP - приложение Так что бы по данным вводимыми нами в диалоговом окне(которое мы тоже программируем,и в котором мы можем задать цвет, размеры и угол поворота относительно оси Х и посмотреть вид) строился прямоугольник в AutoCAD'е

Где же это такой изверг-препод?

[TararykovDG]

Сообщение от 222ketti Так что бы по данным вводимыми нами в диалоговом окне(которое мы тоже программируем,и в котором мы можем задать цвет, размеры и угол поворота относительно оси Х и посмотреть вид)

222ketti, это тоже должно быть реализовано на лиспе?

[Profan]

Про слой забыли.

[Andru1968]

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

[Nike]

Сообщение от Andru1968 Если что "звони" в личку.

а что, тут "есть код" стыдно показать?

[Profan]

Подобная программа (отрисовка прямоугольника под углом) есть в PLTools.

[Do$]

Стандартная команда RECTANG тоже может под углом прямоугольник рисовать.

[Nike]

и POLYGON тоже может

[Andru1968]

Сообщение от Nike а что, тут "есть код" стыдно показать?

нет не стыдно

[Nike]

Сообщение от Andru1968 нет не стыдно

ну тогда вываливай

[Andru1968]

Сообщение от Nike ну тогда вываливай

а оно надо, обсуждать код, который рабочий на все 100%. Но он сделан для решения определенных задач, а для решения задачи поставленной перед 222ketti, он может и не подойдет.

Сообщение от 222ketti Помогите написать программу

Если 222ketti будет интересно его посмотреть я ему и так отправлю, а захочет обсудить с другими его применение для своей задачи выложит сам.

[222ketti]

Сообщение от Alan Где же это такой изверг-препод?

Политех

Нужно исключительно в AutoLisp'e

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

Как вариант, по-быстрому и не очень качественно:

Код:

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

 (vl-load-com)

(defun c:mrec (/ fun_change_color fun_change_lst fun_change adoc file handle dcl_id pt dcl_lst)

  (defun fun_change_color (/ res)
    (if (setq res (acad_colordlg 1))
      (set_tile "box_color" (itoa res))
      (set_tile "box_color" "")
      ) ;_ end of if
    (fun_change_lst "box_color" res)
    ) ;_ end of defun

  (defun fun_change_lst (key value)
    (setq dcl_lst (if (assoc (setq key (vl-string-trim "box_" key)) dcl_lst)
                    (subst (cons key value) (assoc key dcl_lst) dcl_lst)
                    (cons (cons key value) dcl_lst)
                    ) ;_ end of if
          ) ;_ end of setq
    ) ;_ end of defun

  (defun fun_change (key value)
    (cond
      ((and (= key "box_color")
            (< 0 (setq value (atoi value)) 256)
            ) ;_ end of and
       (fun_change_lst key value)
          ;(mode_tile "accept" 0)
       )
      ((and (= key "box_width")
            (< 0 (setq value (atof (vl-string-subst "." "," value))))
            ) ;_ end of and
       (fun_change_lst key value)
          ;(mode_tile "accept" 0)
       )
      ((and (= key "box_height")
            (< 0 (setq value (atof (vl-string-subst "." "," value))))
            ) ;_ end of and
       (fun_change_lst key value)
          ;(mode_tile "accept" 0)
       )
      ((and (= key "box_angle")
            (< 0 (setq value (atof (vl-string-subst "." "," value))))
            ) ;_ end of and
       (fun_change_lst key value)
          ;(mode_tile "accept" 0)
       )
      (t
          ;(mode_tile "accept" 1)
       (fun_change_lst key nil)
       )
      ) ;_ end of cond
    ) ;_ end of defun

  (setq file   (strcat (vl-string-right-trim "\\" (getenv "tmp")) "\\dlg.dcl")
        handle (open file "w")
        ) ;_ end of setq
  (foreach item '("dlg:dialog{"
                  ":row{label=\"Задание цвета\";"
                  "	:edit_box{key=\"box_color\";label=\"Цвет\";}"
                  "	:button{key=\"btn_color\";label=\"...\";width=3;}"
                  "	}"
                  ":row{label=\"Задание геометрии\";"
                  "	:edit_box{key=\"box_width\";label=\"Ширина\";}"
                  "	:edit_box{key=\"box_height\";label=\"Высота\";}"
                  "	:edit_box{key=\"box_angle\";label=\"Угол поворота, градусы\";}"
                  "	}"
                  "ok_cancel;"
                  "}"
                  )
    (write-line item handle)
    ) ;_ end of foreach
  (close handle)
  (setq dcl_id (load_dialog file))
  (new_dialog "dlg" dcl_id)
  (action_tile "btn_color" "(fun_change_color)")
  (action_tile "box_color" "(fun_change $key $value)")
  (action_tile "box_width" "(fun_change $key $value)")
  (action_tile "box_height" "(fun_change $key $value)")
  (action_tile "box_angle" "(fun_change $key $value)")
  (setq dcl_lst nil)
  (setq dcl_res (start_dialog))
  (unload_dialog dcl_id)
  (if (= dcl_res 1)
    (if (apply 'and
               (mapcar '(lambda (x)
                          (cdr (assoc x dcl_lst))
                          ) ;_ end of lambda
                       '("color" "height" "width" "angle")
                       ) ;_ end of mapcar
               ) ;_ end of apply
      (if (and
            (setq dcl_lst (subst (cons "angle" (/ (* (cdr (assoc "angle" dcl_lst)) pi) 180.))
                                 (assoc "angle" dcl_lst)
                                 dcl_lst
                                 ) ;_ end of subst
                  ) ;_ end of setq
            (= (type (setq pt (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (getpoint "\nУкажите нижний левый угол прямоугольника <Отмена> : ")
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                           ) ;_ end of setq
                     ) ;_ end of type
               'list
               ) ;_ end of =
            ) ;_ end of and
        (entmakex
          (append
            (list '(0 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 62 (cdr (assoc "color" dcl_lst)))
                  '(90 . 4)
                  '(70 . 1)
                  '(43 . 0.0)
                  '(38 . 0.0)
                  '(39 . 0.0)
                  ) ;_ end of list
            (mapcar
              (function
                (lambda (x)
                  (cons 10 x)
                  ) ;_ end of lambda
                ) ;_ end of function
              (list pt
                    (setq pt (polar pt (cdr (assoc "angle" dcl_lst)) (cdr (assoc "width" dcl_lst))))
                    (setq pt (polar pt (+ (/ pi 2.) (cdr (assoc "angle" dcl_lst))) (cdr (assoc "height" dcl_lst))))
                    (polar pt (+ pi (cdr (assoc "angle" dcl_lst))) (cdr (assoc "width" dcl_lst)))
                    ) ;_ end of list
              ) ;_ end of mapcar
            ) ;_ end of append
          ) ;_ end of entmakex
        ) ;_ end of if
      (alert "Введены не все значения, запускайте снова!")
      ) ;_ end of if
    ) ;_ end of if
          (princ)
  ) ;_ end of defun

[CB]

Здесь небольшая ошибка

Код:

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

 (fun_change_lst "box_color" (itoa res))  ->  (fun_change_lst "box_color" res)

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

Спасибо, исправил.

[Alan]

Сообщение от Кулик Алексей aka kpblc Как вариант, по-быстрому и не очень качественно:

Алексей,
и ты думаешь препод поверит, что это ОНА написала? Я съем свою шляпу!

[Дима_]

Вобще таких преподов надо дисквалифицировать - если это не "основной" предмет - достаточно изучение основ лиспа, если есть цель "серьезно" изчить вопрос - то уделили-бы внимание куда более важным вещам чем DCL. DCL это трупп, непрминимый больше ни где ни сам, ни как принцип (только не надо сейчас WPF приплетать), на его узучение надо потратить приличное количество времени с забиванием в голову ненужной ерунды - вся суть кода это написание оболочки вокруг примитивной операции. Вобщем ИХМО, полный дятел, тот преподователь, который такую программу ввел (если она не была написанна лет 20 назад, когда других вариантов не было, тогда дятел тот - кто ничего все эти 20 лет не делал). В итоге - 222keti скачает, препод боюсь сам удивится что заработало - пользы - ну только что Крыс пальцы размял.

[Do$]

Сообщение от Дима_ на его узучение надо потратить приличное количество времени

Гораздо меньше, чем на любую альтернативу.

[gomer]

Чего вы раскричались? Препод - дурак. Автолисп - фигня... Сделайте девушке нормальную студенческую программу за небольшое вознаграждение Или слабо?