Тема: 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