(изменено: Disney, 19 декабря 2010г. 09:31:36)

Тема: LISP. Рисуем ЛЕП на топопланах

(defun C:lep ()
  (setvar "cmdecho" 0)            ;отключение эха
  (setq osm (getvar "OSMODE"))        ;Запоминает настройку объектной привязки
  (setvar "osmode" 8)            ;Включает объектную привязку узел
;;;;;;;;;;;;;;;;;;;;;;;;;;;МАСШТАБ
  (if (null mt)                ;Если масштаб не был задан ранее
    (setq mt "5")            ;присваеваем по умолчанию значение 1:500
  )                    ;конец IF
  (setq my 1)                ;Создаём условие для выполнения цикла по запросу масштаба
  (while (= my 1)
    (princ
      (strcat "\n Введите масштаб \n1:1000-1  1:2000-2  1:500-5 <"
          mt
          ">: "
      )
    )                    ;Пишем подсказку
    (setq m (getint))
    (if    (null m)            ;Если пользоваетль не ввёл
      (setq m (atoi mt))        ;присваеваем по умолчанию
      (setq mt (itoa m))        ;Если масштаб ввёл пользователь, задаём его по умолчанию для следующего раза
    )                    ;Конец IF
    (if    (or (= m 1) (= m 2) (= m 5))
      (progn
    (setq my 2)
    (cond
      ((= m 1) (setq m 1))
      ((= m 2) (setq m 2))
      ((= m 5) (setq m 0.5))
    )                ;Конец COND
      )                    ;Конец PROGN
      (princ "\n Попробуем ещё раз")
    )                    ;Конец IF
  )                    ;Конец WHILE
;;;;;;;;;;;;;;;;;;;;;;;;;;ТИП ОПОРЫ
  (if (null opt)            ;Если тип столба не был задан ранее
    (setq opt "1")            ;присваеваем по умолчанию значение бетонный
  )                    ;конец IF
  (setq opy 1)                ;Создаём условие для выполнения цикла по запросу типа столба
  (while (= opy 1)
    (princ
      (strcat "\n Введите тип опоры \nЖелезобетон-1 Дерев.-2   <"
          opt
          ">: "
      )
    )                    ;Пишем подсказку
    (setq op (getint))
    (if    (null op)            ;Если пользоваетль не ввёл
      (setq op (atoi opt))        ;присваеваем по умолчанию
      (setq opt (itoa op))        ;Если тип опоры ввёл пользователь, задаём его по умолчанию для следующего раза
    )                    ;Конец IF
    (if    (or (= op 1) (= op 2))
      (setq opy 2)
      (princ "\n Попробуем ещё раз")
    )                    ;Конец IF
  )                    ;Конец WHILE
;;;;;;;;;;;;;;;;;;;;;;;;ПОДПИСЬ ПРОВОДОВ
  (setq z (getint "\nВведите через сколько столбов подписывать ЛЕП: "))
                    ;Запрашиваем число проводов
  (setq z (/ 1.1 z))            ;Задаём шаг изменения Х для подписи ЛЕП через определённое число столбов
  (setq x 1)                ;Создаём условие для подписи первого столба
  (setq j 1)                ;Создаём условие для выполнения запроса на число проводов
  (setq k 1)                ;Создаём условие для выполнения запроса на напряжение ЛУП
  (setq i 1)                ;Создаём условие на выполнение цикла по рисованию ЛЕП
;;;;;;;;;;;;;;;;;;;;;;;;ЧИСЛО ПРОВОДОВ
  (while (= j 1)
    (setq p1 (getint "\nВведите число проводов (1 - 12): "))
                    ;Запрашиваем число проводов
    (if    (and (> p1 0) (< p1 13))    ;Проверяем правильность ввода
      (progn
    (setq p1 (itoa p1))        ;Преобразуем число проводов из целого в строку
    (setq j 2)            ;Создаём условия для завершения цикла
      )                    ;конец PROGN
      (princ "\n Где вы видели столько проводов?")
                    ;Повторяем запрос на число проводов, т.к. если указано не верно
    )                    ;Конец IF
  )                    ;Конец WHILE
;;;;;;;;;;;;;;;;;;;;;;;;НАПРЯЖЕНИЕ ЛЕП
  (while (= k 1)
    (setq n1 (getreal "\nВведите Напряжение ЛЕП (0.4 - 110) кВ: "))
                    ;Запрашиваем напряжение ЛЕП
    (if    (and (> n1 0) (< n1 111))
                    ;Проверяем правильность ввода
      (progn
    (if (< n1 1)            ;Выясняем есть ли значещии цифры после запятой
      (progn
        (setq n1 (rtos n1 2 1))    ;Преобразуем напряжение из вещественного в строку
        (setq ds 0)            ;Если ЛЕП низковольтная <1 кВ то рисуем одну стрелку
        (setq k 2)            ;Создаём условия для завершения цикла
      )                ;Конец PROGN
      (progn
        (setq n1 (rtos n1 2 0))    ;Преобразуем напряжение из вещественного в строку
        (setq ds 1)            ;Если ЛЕП высоковольтноя >1 кВ то рисуем две стрелки
        (setq k 2)            ;Создаём условия для завершения цикла
      )                ;Конец PROGN
    )                ;Конец IF
      )                    ;Конец PROGN
      (princ "\n Где вы видели такое напряжение?")
                    ;Повторяем запрос на напряжение ЛЕП, т.к. если указано не верно
    )                    ;Конец IF
  )                    ;Конец WHILE
  (setq p2 "пр. ")
  (setq p (strcat p1 p2))        ;Получаем харрактеристику ЛЕП/число проводов
  (setq n2 "кВ")
  (setq n (strcat n1 n2))        ;Получаем харрактеристику ЛЕП/напряжение
;;;;;;;;;;;;;;;;;;;;;;;;НАЧИЕНАЕМ РИСОВАТЬ
  (setq a1 (getpoint "\nУкажите начальное направление ЛЭП"))
                    ;Запрашеваем начальное направление ЛЕП
  (setq a2 (getpoint a1 "\nУкажите солб ЛЭП"))
                    ;Запрашеваем местоположение столба ЛЕП
  (while (= i 1)            ;Пока i=1 рисуем ЛЭП
    (setq a3
       (getpoint
         a2
         "\nУкажите следующий столб или конечное направление ЛЭП / Для завершения кликните на конечное направление леп"
       )
    )
    (if    (equal a3 a2)            ;Проверяем продолжить или завершить рисование ЛЕП
      (setq i 45)            ;Создаём условия для завершения цикла рисования ЛЕП
    )                    ;Конец IF
;;;;;;;;;;;;;;;;;;;;;;;;КООРДИНАТЫ ДЛЯ СТРЕЛОК НИЗКОВОЛЬТНОЙ ЛЕП
    (If    (= i 1)
      (progn
    (setq ugl21 (angle a2 a1))    ;Определяем угол со столба на начальное направление
    (setq ann (polar a2 ugl21 (* 4.5 m)))
                    ;Определяем координату начала стрелки от начального напровления
    (setq akn (polar a2 ugl21 (* 0.5 m)))
                    ;Определяем координату конца стрелки от начального напровления
    (setq ansv (polar a2 (+ ugl21 0.139626337) (* 3.1717 m)))
                    ;Определяем координату стрелки от начального напровления
    (setq ansn (polar a2 (- ugl21 0.139626337) (* 3.1717 m)))
                    ;Определяем координату стрелки от начального напровления
    (setq ugl23 (angle a2 a3))    ;Определяем угол со столба на конечное направление
    (setq ank (polar a2 ugl23 (* 4.5 m)))
                    ;Определяем координату конца стрелки на конечное направление
    (setq akk (polar a2 ugl23 (* 0.5 m)))
                    ;Определяем координату начала стрелки на конечное направление
    (setq aksv (polar a2 (+ ugl23 0.139626337) (* 3.1717 m)))
                    ;Определяем координату стрелки конечного напровления
    (setq aksn (polar a2 (- ugl23 0.139626337) (* 3.1717 m)))
                    ;Определяем координату стрелки конечного напровления
;;;;;;;;;;;;;;;;;;;;;;;;КООРДИНАТЫ ДЛЯ ВТОРОЙ ПАРЫ СТРЕЛОК ВЫСОКОВОЛЬНОЙ ЛЕП
    (if (= ds 1)
      (progn
        (setq nvs (polar a2 ugl21 (* 2.942 m)))
                    ;Определяем координату начала стрелки
        (setq nvsv (polar a2 (+ ugl21 0.2855) (* 1.6568 m)))
                    ;Определяем координату стрелки
        (setq nvsn (polar a2 (- ugl21 0.2855) (* 1.6568 m)))
                    ;Определяем координату стрелки
        (setq kvs (polar a2 ugl23 (* 2.942 m)))
                    ;Определяем координату начала стрелки
        (setq kvsv (polar a2 (+ ugl23 0.2855) (* 1.6568 m)))
                    ;Определяем координату стрелки
        (setq kvsn (polar a2 (- ugl23 0.2855) (* 1.6568 m)))
                    ;Определяем координату стрелки
        (command "_line" nvs nvsv "")
        (command "_line" nvs nvsn "")
        (command "_line" kvs kvsv "")
        (command "_line" kvs kvsn "")
      )                ;Конец PROGN
    )                ;Конец IF
    (command "_line" ann akn "")
    (command "_line" ank akk "")
    (command "_line" ansn ann "")
    (command "_line" ansv ann "")
    (command "_line" aksn ank "")
    (command "_line" aksv ank "")
    (cond
      ((= op 1)
       (command "_circle" a2 (* 0.5 m))
       (command "_circle" a2 (* 0.01))
      )
      ((= op 2) (command "_circle" a2 (* 0.5 m)))
    )
;;;;;;;;;;;;;;;;;;;;;;;;ПОДПИСЫВАЕМ ЛЕП
    (setq x (+ x z))        ;
    (if (> x 1)
      (progn
        (if    (or (< ugl23 (/ pi 2)) (> ugl23 (* pi 1.5)))
                    ;Проверяем угол наклона, что бы надпись не была к верх нагами
          (progn
        (setq ktp (polar a2 (+ ugl23 (/ pi 2)) (* 0.8 m)))
                    ;Определяем координату для текста провода
        (setq ktn (polar a2 (- ugl23 (/ pi 2)) (* 2.6 m)))
                    ;Определяем координаты для текста напряжение
        (setq ugl (angtos ugl23 0 5))
                    ;переводим угол из радиан в градусы
          )                ;Конец PROGN            
          (progn
        (setq ktp (polar a2 (+ ugl21 (/ pi 2)) (* 0.8 m)))
                    ;Определяем координату для текста провода
        (setq ktn (polar a2 (- ugl21 (/ pi 2)) (* 2.6 m)))
                    ;Определяем координаты для текста напряжение
        (setq ugl (angtos ugl21 0 5))
                    ;переводим угол из радиан в градусы
          )                ;Конец PROGN
        )                ;Конец IF
        (command "_TEXT" ktp (* 1.8 m) ugl p) ;Подписываем провода
        (command "_TEXT" ktn (* 1.8 m) ugl n)
                    ;Подписываем напряжение
        (setq x 0)
      )                ;Конец PROGN
    )                ;Конец IF
    (setq a1 a2)
    (setq a2 a3)
      )                    ;Конец PROGN
    )                    ;Конец IF
  )                    ;Конец WHILE
  (setvar "osmode" osm)            ;восстанавливает объектную привязку
  (princ "\nКоманда:")
  (princ "\nКоманда:")
  (princ "\nКоманда:")                                                                                                                                                                                               
)                    ;Конец defun

Re: LISP. Рисуем ЛЕП на топопланах

Нет. Не понравилось. По нескольким причинам:
1. Написано без обработчика ошибок.
2. Используются глобальные переменные, хотя можно работать со словарями.
3. Ввод масштаба можно было сделать через initget и getkword.
4. Имена глобальных переменных таковы, что аналогичным образом написанное приложение их заменит и не поморщится.
5. Используются несколько setq  подряд вместо одного.
6. Используется командный метод, а не создание примитивов "напрямую". Что вкупе с переназначенным osmode может иногда привести к "непонятным" результатам.
7. Текстовый стиль, установленный у пользователя, может иметь фиксированную высоту. И все (command "_.text") можно будет выкидывать нафиг.
И, наконец, последнее. Не слишком ли нагло просить деньги за непрофессионально написанное приложение? А?

Re: LISP. Рисуем ЛЕП на топопланах

ЛЭП

Re: LISP. Рисуем ЛЕП на топопланах

To Кулик Алексей
Согласен, но моя профессия совсем не САПР, а всего лиш геодезист, неделю назат я впервые открыл учебник по LISP. Поэтому не стоит так категорично критиковать. А про деньги это шутка, ведь даже если бы это программка тебя восхитила, ты бы всё равно денег бы не прислал!

Re: LISP. Рисуем ЛЕП на топопланах

> Disney
Неплохо. Только не хватает нескольких опций.
1.Нет металлического столба
2.ЛЭП отрисовывается только с разрывом (на незастроенной территории д.б. сплошной линией)
3.Стрелки выглядят некрасиво (не похоже на У.З)
4.Не запоминаются характеристики ЛЭП для повторного использования.
5.Выход из программы странный. С первого раза не получилось выйти, со второго с трудом. Лучше сделать стандартно по правому клику, Enter, ESC.