![]() |
|
|
![]()
|
|
| YauhenX |
|
|||
|
Новичок Профиль Группа: Участник Сообщений: 1 Регистрация: 5.2.2011 Репутация: нет Всего: нет |
Выравнивание отрезков. При создании чертежа с выключенной опцией “Ortho” возможна ситуация, при которой проектировщик может ошибочно начертить линии не абсолютно вертикально или горизонтально, а с небольшой погрешностью, т.е. координаты X, Y начала и конца отрезка отличаются в десятых, или в сотых долях единиц. Диалоговое окно программы должно позволять задать допустимое значение отклонения по каждой оси, менее которого, отрезок будет считаться не строго горизонтальным, либо вертикальным. Такие отрезки, найденные программой в чертеже должны подвергаться выравниванию. При этом, координата начальной точки по оси выравнивания записывается в соответствующую координату конечной точки.
Помогите найти ошибку dcl файл Menu: dialog{ label="Программа коррекции линий"; :boxed_column { : edit_box { label = "Введите максимальную разницу по X:"; value = 0.1; edit_limit = 15; edit_width = 10; fixed_width = true; key = "dx"; } : edit_box { label = "Введите максимальную разницу по Y:"; value = 0.1; edit_limit = 15; edit_width = 10; fixed_width = true; key = "dy"; } } ok_cancel; } lsp файл (setq ok 0 cancel 0 dx "1" dy "1" ) (defun main_menu () (if (not (new_dialog "Menu" dcl_id)) (exit) ) (set_tile "dx" dx) (set_tile "dy" dy) (action_tile "dx" "(setq dx $value)") (action_tile "dy" "(setq dy $value)") (action_tile "accept" "(done_dialog 1)(setq ok 1)") (action_tile "cancel" "(setq cancel 1)") (setq what_next (start_dialog)) ) ; Основная программа (setq dcl_id (load_dialog "d:\\rsa.dcl")) (while (and (= ok 0)(= cancel 0)) (main_menu)) (unload_dialog dcl_id) (setq fdx (atof dx)) (setq fdy (atof dy)) (if (= cancel 1)(prompt "\nРабота алгоритма коррекции отменена\n")) (if (= ok 1) (progn ; global calculations block (setq objlist (ssget "X" '((0 . "LINE")))) (setq count 0) ; count of object which were modified (setq total (sslength objlist)) (setq iterator 0) (repeat total (setq curobj (ssname objlist iterator)) (setq ed (entget curobj)) (setq pt1 (assoc 10 ed)) (setq pt2 (assoc 11 ed)) ; Retreives the coordinates of point 1 (setq x1 (nth 1 pt1)) (setq y1 (nth 2 pt1)) ; Retreives the coordinates of point 2 (setq x2 (nth 1 pt2)) (setq y2 (nth 2 pt2)) (setq _fdx (- x1 x2)) (setq _fdy (- y1 y2)) (if (<= _fdx 0) (setq _fdx (* -1 _fdx))) (if (<= _fdy 0) (setq _fdy (* -1 _fdy))) (setq flag 0) ; shows if an object was modified (if (/= x1 x2) (progn (if (<= _fdx fdx) (progn ; x = xmin + (xmax - xmin) / 2 (setq x (+ (min x1 x2) (/ (- (max x1 x2) (min x1 x2)) 2))) (setq x1 x) (setq x2 x) (setq flag 1) )) )) (if (/= y1 y2) (progn (if (<= _fdy fdy) (progn (setq y (+ (min y1 y2) (/ (- (max y1 y2) (min y1 y2)) 2))) (setq y1 y) (setq y2 y) (setq flag 1) )) )) (setq ed (subst (list 10 x1 y1 ) (assoc 10 ed) ed)) (setq ed (subst (list 11 x2 y2 ) (assoc 11 ed) ed)) (if (= flag 1) (setq count (1+ count))) (setq iterator (1+ iterator)) (entmod ed) (entupd curobj) (setq curobj (entnext curobj)) ) (setq msg0 "\nКоличество обработанных линий: ") (setq msg1 (strcat msg0 (itoa total))) (setq msg2 "\nКоличество скорректированных линий: ") (setq msg3 (strcat msg2 (itoa count))) (prompt "\nРезультаты работы программы:\n") (prompt "------------------------------") (prompt msg1) (prompt msg3) (prompt "\nРабота программы успешно завершена!\n") )) ; end of global calculations block |
|||
|
||||
![]()
|
| Правила форума LISP | |
|
|
Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Void. |
| 0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей) | |
| 0 Пользователей: | |
| « Предыдущая тема | LISP | Следующая тема » |
|
|
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности Powered by Invision Power Board(R) 1.3 © 2003 IPS, Inc. |