[Only_War]

Есть лисп такого вида:

Код:

[Выделить все]

 (defun c:vktr2d	() 
(setvar "angdir" 0) 
(setq prov (tblsearch "BLOCK" "STRELA")) 
(if (= prov nil) 
(progn 
(command "_layer" "_m" "0" "") 
(command "_color" "_byblock") 
(command "_zoom" "_a") 
(command "_pline"	 "_non" "0.5,-0.1" "_w" 
"0.0"	 "0.0" "_non"	 "3.0,-0.1" 
"_non"	 "2.7,-0.4" "_non"	 "5.0,0.0" 
"_non"	 "2.7,0.4" "_non"	 "3.0,0.1" 
"_non"	 "0.5,0.1" "_c"	 "" 
) 
(setq strlk (entlast)) 
(command "_color" "_bylayer") 
(command "_block" "strela" "_non" "0,0,0" strlk "") 
) 
) 

(command "_layer" "_m" "vektor2d" "") 
(setq mb (getreal "\n Масштаб печати : ")) 
(setq d1 (/ 1.5 mb)) 
(setq -d1 (- 0.0 d1)) 
(setq d2 (/ 7.0 mb)) 
(setq -d2 (- 0.0 d2)) 
(setq mbstr (/ 1.0 mb)) 
(setq mbtxt (/ 2.0 mb)) 
(setq dopusk (getreal "\n Допустимое отклонение конструкции в мм: ")) 
(setq kod (getstring "\n Направление векторов X или Y : ")) 
(setq kod (strcase kod)) 




; 
(while t 
(setq p1 (getpoint "\n Измеренная точка 1") 
p2 (getpoint "\n Измеренная точка 2") 
) 
(if	(< (last p2) (last p1)) 
(progn (setq ps p1 
p1 p2 
p2 ps 
) 
) 
) 
(setq p3 (getpoint "\n Проектная точка")) 

(setq p4 (getpoint "\n Сторона отрисовки вектора")) 

(setq dp1 (mapcar '- p1 p3) 
dp2 (mapcar '- p2 p3) 
dnpr (mapcar '- p4 p3) 
pp3 (list (car p3) (cadr p3)) 
) 

(setq k 1) 
(repeat 2 
(if (/= kod "Y") 
(progn 
(setq	xnpr (car dnpr) 
rottxt "0" 
) 

(cond 
((= k 1) 
(command "_color" "_g") 
(setq dx (car dp1)) 
(cond 
((>= xnpr 0) 
(setq ptst (mapcar '+ pp3 (list d2 -d1)) 
tipvst "_ml" 
) 

(cond 
((>= dx 0) (setq pstr (mapcar '+ pp3 (list d1 -d1)))) 
((< dx 0) (setq pstr ptst)) 
) 
) 

((< xnpr 0) 
(setq ptst (mapcar '+ pp3 (list -d2 -d1)) 
tipvst "_mr" 
) 

(cond 
((< dx 0) (setq pstr (mapcar '+ pp3 (list -d1 -d1)))) 
((>= dx 0) (setq pstr ptst)) 
) 
) 
) 
) 

((= k 2) 
(command "_color" "_b") 
(setq dx (car dp2)) 
(cond 
((>= xnpr 0) 
(setq ptst (mapcar '+ pp3 (list d2 d1)) 
tipvst "_ml" 
) 

(cond 
((>= dx 0) (setq pstr (mapcar '+ pp3 (list d1 d1)))) 
((< dx 0) (setq pstr ptst)) 
) 
) 

((< xnpr 0) 
(setq ptst (mapcar '+ pp3 (list -d2 d1)) 
tipvst "_mr" 
) 

(cond 
((< dx 0) (setq pstr (mapcar '+ pp3 (list -d1 d1)))) 
((>= dx 0) (setq pstr ptst)) 
) 
) 
) 
) 
) 

(setq txt (rtos (* (abs dx) 1000) 2 0)) 
(cond	((>= dx 0) (setq rotstr "0")) 
((< dx 0) (setq rotstr "180")) 
) 

(command "_insert" "strela" "_non" pstr mbstr mbstr rotstr) 
(if (> (* (abs dx) 1000) dopusk) 
(command "_color" "_r") 
) 
(command "_text" "_j" tipvst "_non" ptst mbtxt rottxt txt) 
) 
) 

(if (/= kod "X") 
(progn 
(setq	ynpr (cadr dnpr) 
rottxt "90" 
) 

(cond 
((= k 1) 
(command "_color" "_g") 
(setq dy (cadr dp1)) 

(cond 
((>= ynpr 0) 
(setq ptst (mapcar '+ pp3 (list d1 d2)) 
tipvst "_ml" 
) 

(cond 
((>= dy 0) (setq pstr (mapcar '+ pp3 (list d1 d1)))) 
((< dy 0) (setq pstr ptst)) 
) 
) 

((< ynpr 0) 
(setq ptst (mapcar '+ pp3 (list d1 -d2)) 
tipvst "_mr" 
) 

(cond 
((< dy 0) (setq pstr (mapcar '+ pp3 (list d1 -d1)))) 
((>= dy 0) (setq pstr ptst)) 
) 
) 
) 
) 

((= k 2) 
(command "_color" "_b") 
(setq dy (cadr dp2)) 
(cond 
((>= ynpr 0) 
(setq ptst (mapcar '+ pp3 (list -d1 d2)) 
tipvst "_ml" 
) 

(cond 
((>= dy 0) (setq pstr (mapcar '+ pp3 (list -d1 d1)))) 
((< dy 0) (setq pstr ptst)) 
) 
) 

((< ynpr 0) 
(setq ptst (mapcar '+ pp3 (list -d1 -d2)) 
tipvst "_mr" 
) 

(cond 
((< dy 0) (setq pstr (mapcar '+ pp3 (list -d1 -d1)))) 
((>= dy 0) (setq pstr ptst)) 
) 
) 
) 
) 
) 

(setq txt (rtos (* (abs dy) 1000) 2 0)) 
(cond	((>= dy 0) (setq rotstr "90")) 
((< dy 0) (setq rotstr "270")) 
) 

(command "_insert" "strela" "_non" pstr mbstr mbstr rotstr) 
(if (> (* (abs dy) 1000) dopusk) 
(command "_color" "_r") 
) 
(command "_text" "_j" tipvst "_non" ptst mbtxt rottxt txt) 
) 
) 
(setq k (+ 1 k)) 
) 
) 

С помощью него можно рисовать отклонения от проектного положения вертикальных конструкций по низу и по верху и все вроде бы удобно, но для вывода на печать на черно-белом принтере не удобно, не понятно где верх а где низ, можно ли как нибудь сделать что бы еще расставлялись буквы Н и В, низ и верх соответственно. Кто поможет, за ранее спасибо!

[ciril]

Мне кажется, проще переписать по новой, чем изменить это Опишите задачу и исходные

[Only_War]

Что подразумевается под исходными?имеем только черно белый принтер, при выводе на печать не понятно где верх, а где низ, т.к. Данный лисп разделяет их по цветам, хотелось бы что бы было еще какое нибудь визуальное различие(отклонение по низу в рамочке или подписи н и в), а так вообщем то мне он и в таком виде нравится. А почему его проще заново написать чем исправить?(я просто в этом не разбираюсь, любопытно)?

[ciril]

Потому что, чтобы внести изменения в существующий нужно: понять, что он делает, понять, что он еще должен делать и реализовать дополнительный функционал с учетом того, что уже написано. А по новой писать: понять, что должен делать и реализовать
По исходным подразумевается уж по крайней мере описание кого их приведенный лисп разделяет, то есть, например: есть набор отрезков, нужно вывести отклонения каждого от вертикали текстом с привязкой в верхней точке отрезка. И чертеж с примером прикрепляете.

[Do$]

Да уж, поди догадайся, что эта лиспина делает. Ни одного комментария, ни описания, ни фото/видео примера... Получается так: "Вы разберитесь сами как оно работает и исправьте как мне надо".