Изучаю AutoLISP - Форум
Проектирование
систем связи и
сигнализации
Вторник, 06-Дек-2016, 11:13
Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
Страница 1 из 11
Форум » Разное » Программное обеспечение » Изучаю AutoLISP (отслеживание курсора, перехват ошибки)
Изучаю AutoLISP
MazaiДата: Понедельник, 24-Мар-2008, 16:30 | Сообщение # 1
Рядовой
Группа: Пользователи
Сообщений: 4
Репутация: 0
Статус: Offline
Здравствуйте!
Я пишу простую программку для автокада, которая помогла бы упростить расчёт растояния по точкам - аналог в реале моей работы - это курвиметр. Она просто пишется, ВОТ КОД:

(defun dist_all ()
(setq x1 0)
(setq pt1 (getpoint "\n Start point >"))
(while t
(setq pt2 (getpoint "\n Next point >"))
(setq x (distance pt1 pt2))
(setq pt1 pt2)
(setq x1 (+ x1 x))
(print x1)
)
)

НО у меня появилась необходимость графически оформить это творение, а именно - отслеживать курсор от последней указанной точки. То есть хотелось бы что бы от последней указанной точки к курсору была бы протянута "нить" (линия, например как при построении обычной LINE), есть ли какое-нибудь свойство задаваемое для курсора?
И ещё - данный пример выходит по ошибке (прерывание функции), то есть при нажатие на клавишу Esc. Есть ли функция, перехватывающая эту ошибку - не люблю когда программа заканчиваеться не корректно.

 
NikeДата: Четверг, 27-Мар-2008, 15:55 | Сообщение # 2
Лейтенант
Группа: Проверенные
Сообщений: 42
Репутация: 0
Статус: Offline
(getpoint [<точка>] [<подсказка>])

Эта функция запрашивает от пользователя точку <точка>. Факультативный аргумент - базовая [<точка>] и [<подсказка>] - факультативная запись для высвечивания на экране в качестве подсказки. Вы можете ввести точку путем указания ее на экране или записав координаты в текущих единицах измерения. Если присутствует аргумент <точка>, AutoCAD нарисует "резиновую" линию от этой точки до текущего положения курсора.

т.е. вместо
(setq pt2 (getpoint "\n Next point >"))
нужно
(setq pt2 (getpoint pt1 "\n Next point >"))

 
MazaiДата: Четверг, 27-Мар-2008, 16:20 | Сообщение # 3
Рядовой
Группа: Пользователи
Сообщений: 4
Репутация: 0
Статус: Offline
Спасибо!
Уже сделал, только я сделал ещё лучше:

заменил две строки
(while t
(setq pt2 (getpoint "\n Next point >"))

на одну
(while (setq pt2 (getpoint pt1 "\n Next point >"))
Здесь два зайца. 1-й: при запросе рисуется линия от последней точки до курсора, 2-й: из функции можно корректно выйти, просто нажав пустой ввод (пробел, Enter или правая клава мыши)...

Сообщение отредактировал Mazai - Четверг, 27-Мар-2008, 16:20
 
NikeДата: Четверг, 27-Мар-2008, 18:27 | Сообщение # 4
Лейтенант
Группа: Проверенные
Сообщений: 42
Репутация: 0
Статус: Offline
тоже правильно..
Вот кстати подобная программулька из моей коллекции с возможностью отрисовки линий на отдельном слое:

Code

; Подсчет длины участка трассы, указываемой последовательными точками.
; Заказчик - отдел 10, май 2004г.
; Вызов: (dist_point nil) - подсчет длины трассы без создания доп. вспомогательного слоя и отрисовки линии
; (dist_point t) - создается, если отсутствует в базе рисунка слой "_Длина участков_", отрисовываетеся линия.
; По окончании работы команды возвращается исходный текущий слой и цвет.
; Имеется возможность отмены последнего шага внутри команды - опция undo.
; Справочно отображаются координаты введенных точек.
(defun dist_point (ttt / pt pt2 d tlayer ccol) ; ttt - признак необоходимости рисовать линию - T - рисовать, nil - не рисовать
(setvar "CMDECHO" 0)
(setq olderr *error*
*error* delle
)
; прочитать и запомнить текущий слой, цвет, потом восстановить
;
(if ttt ; нужно рисовать линию и настраивать цвета и слои
(progn (setq tlayer (getvar "CLAYER")) ; запомнить текущий слой
(setq ccol (getvar "CECOLOR")) ; запомнить текущий цвет
(if (not (tblsearch "LAYER" "_Длина участков_"))
(progn (command "_layer" "_m" "_Длина участков_" "_color" "1" "") ;создать слой
(command)
) ;_ end of progn
) ; if
; текущий слой
;
(command "_layer" "_set" "_Длина участков_")
(command)
(command "_-color" "_bylayer")
) ;_ end of progn
) ; IF ttt
(setq d 0
pt (list nil)
) ;_ end of setq
(initget 46)
(setq pt (cons (getpoint "\nПервая точка: ") pt))
(while (car pt)
(princ (car pt))
(initget 46 "Undo")
(setq pt2 (getpoint (car pt) "\nТочка [Undo]:"))
(cond
((or (equal pt2 "u") (equal pt2 "U") (equal pt2 "Undo"))
; шаг назад удалить первый элемент списка из списка и вычесть предыдущее расстояние из d
(progn (if (and (car pt) (cadr pt)) ; два значимых элемента в списке
(progn (setq d (- d (distance (car pt) (cadr pt))))
(if ttt
(entdel (entlast))
) ; удалить последний отрезок


Сообщение отредактировал Nike - Четверг, 27-Мар-2008, 18:28
 
NikeДата: Четверг, 27-Мар-2008, 18:28 | Сообщение # 5
Лейтенант
Группа: Проверенные
Сообщений: 42
Репутация: 0
Статус: Offline
Code
  
  ; вычесть из длины последний участок
                 ) ; progn
               ) ; if
               (setq pt (cdr pt))
        ) ;_ end of progn
       )  
       ((not pt2) (setq pt (cons pt2 pt))) ; пустой ввод
        ((listp pt2) ; значимая точка
        (progn (setq d  (+ d (distance (car pt) pt2))
                     pt (cons pt2 pt)
               ) ;_ end of setq
               (if ttt ; нужно рисовать
                 (command "_line" (cadr pt) (car pt) "")
               ) ;_ end of if
        ) ;progn
       )
     ) ;_ end of cond
   ) ; восстановить начальный слой и цвет
   (if ttt
     (progn (command "_layer" "_set" tlayer) (command) (command "_-color" ccol))
   ) ;_ end of if
   (princ "*** Длина участка = ")
   (princ d)
   (princ)
) ;_ end of defun

(defun delle (s) ; Если встретилась ошибка (такая как CTRL-C)
     ; пока эта команда активна...
   (menucmd "S=S")
   (if (/= s "Функция прервана")
     (progn (princ (strcat "\nОшибка: " s)) (command "_layer" "_set" tlayer))
   ) ;_ end of if
   (setq *error* olderr) ; Восстановить старый обработчик *error*
   (princ)
) ;_ end of defun

Здесь, кстати, есть функция обработки ошибки при нажатии ESС или CTRL-C

 
NikeДата: Четверг, 27-Мар-2008, 18:30 | Сообщение # 6
Лейтенант
Группа: Проверенные
Сообщений: 42
Репутация: 0
Статус: Offline
Прошу пардону, целиком текст в одно сообщение не влез - лимит на длину сообщения,
пришлось разбить на два фрагмента...
 
Форум » Разное » Программное обеспечение » Изучаю AutoLISP (отслеживание курсора, перехват ошибки)
Страница 1 из 11
Поиск:

Copyright MyCorp © 2016Сайт управляется системой uCoz