Page 69 - AutoLISP и Visual LISP в среде AutoCAD

Программа на AutoLisp

(command "undefine" "DIST") ; Отменяем команду AutoCad DIST
(defun C:DIST ( / dcl_id n R xy) ; Определяем новую команду DIST
; Устанавливаем начальные значения
(setq n 2 ;любое число больше 1
R "" ;"пустая" сторка
xy (quote (-1 -1)) ; точка (-1,-1)
)
; Загружаем файл диалога
; ЕСЛИ файл диалога не найден - выход
(if (= -1 (setq dcl_id (load_dialog "dist.dcl")))
(progn
(princ "\nНе могу загрузить dist.dcl !!!")
(exit)
)
); if
; Определяем функцию pic, которая возвращает
; список из координат двух указанных точек
(defun pic (/ p1 p2)
(initget 1) ; Запрещаем пустой ввод для первой точки
(setq p1 (getpoint "\nУкажите первую точку:"))
(initget 1) ; Запрещаем пустой ввод для второй точки
(setq p2 (getpoint p1 "\nУкажите вторую точку:"))
(list p1 p2) ; Возвращаемое значение
); defun

; Начало главного цикла (ПОКА n> 1)
(while (> n 1)
(if (not (new_dialog "dist" dcl_id "" xy)) ;ЕСЛИ диалог найден ...
;ТОГДА
;отобразить диалоговое
;окно в точке xy
;(при первом запуске
;в центре экрана)
(exit) ;ИНАЧЕ выход
);if
; Назначаем действия при нажатии кнопок
; Если нажата кнопка <Выход> - завершить диалог с кодом 1
(action_tile "exit" "(done_dialog 1)")
;если нажата кнопка <Указать точки> - завершить диалог с кодом 2
(action_tile "pt" "(setq xy (done_dialog 2))")
(if (= R "") ;ЕСЛИ точки еще не введены (первый запуск) ...
(set_tile "l" R) ;ТОГДА очистить поле <Растояние между точками>
(progn ;ИНАЧЕ заполнить поля всех элементов управления
(set_tile "l" (rtos (distance (car R) (cadr R))))
(set_tile "x1" (strcat (get_tile "x1") (rtos (car (car R)))))
(set_tile "x2" (strcat (get_tile "x2") (rtos (car (cadr R)))))
(set_tile "y1" (strcat (get_tile "y1") (rtos (cadr (car R)))))
(set_tile "y2" (strcat (get_tile "y2") (rtos (cadr (cadr R)))))
(set_tile "z1" (strcat (get_tile "z1") (rtos (caddr (car R)))))
(set_tile "z2" (strcat (get_tile "z2") (rtos (caddr (cadr R)))))
);end progn
);if
(setq n (start_dialog)) ; Получаем код завершения диалога
(if (= n 2) ; ЕСЛИ n=2 ...

68