> 1 <

Автор Сообщение

YauhenX

Members


Статус

1 сообщений

Где: Belarus
Род занятий:
Возраст:

#3906   2011-02-05 21:23 GMT+3 часа(ов)      
Выравнивание отрезков. При создании чертежа с выключенной опцией “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

gomer

Members


Статус

24 сообщений

Где: Ukraine
Род занятий:
Возраст:

#4509   2011-07-03 14:32 GMT+3 часа(ов)      
(defun c:rsa ( /  what_next)
 
(defun main_menu ( / dcl_id )
(setq
dx "1"
dy "1"
)
(if (> 0 (setq dcl_id (load_dialog "rsa.dcl")))
(exit)
)
(if (not (new_dialog "Menu" dcl_id))
(exit)
)
 
(set_tile "dx" dx)
(set_tile "dy" dy)
 
(action_tile "accept" "(setq dx (get_tile \"dx\") dy (get_tile \"dy\"))(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
 
(setq what_next (start_dialog))
(unload_dialog dcl_id)
 
)
 
 
;;; Основная программа
 
(main_menu)
 
(setq fdx (atof dx))
(setq fdy (atof dy))
 
(if (zerop what_next)
(progn
(prompt "\nРабота алгоритма коррекции отменена!")
)
(if (setq objlist (ssget "X" '((0 . "LINE"))))
(progn ; global calculations block
(setq
objlist (ssget "X" '((0 . "LINE")))
count 0 ; count of object which were modified
total (sslength objlist)
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")
)
(prompt "\nНет линий!")
)
) ; end of global calculations block
(princ)
)
 
> 1 <


Онлайн :

0 пользователь(ей), 29 гость(ей) :