[nynokne]

Здравствуйте.
Помогите решить проблему:
Есть 2 слоя "Слой_1" "Слой_2". В данных слоях есть отрезки, при чём Y координаты конца отрезков в слое "Слой_1" равно Y координаты конца отрезков в слое "Слой_2".
Необходимо проанализировать наличие всех отрезков на слое "Слой_1", от всех этих отрезков построить вертикальные отрезки длиной 10 единиц.
Далее необходимо узнать все расстояния от полученных отрезков до каждого отрезка слоя "Слой_2" и подписать только минимальные (справа и слева).

Прикинул код программы (не судите строго - я неделю пытаюсь разобраться в лиспе):

Код:

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

 (setq SS (ssget "_X" '((0 . "LINE") (8 . "Слой_1"))))
(setq i 0)
	(while (< i (sslength SS))
	        (setq line_obj (ssname SS i))
	        (setq line (entget line_obj))
		(setq koord_line (cdr (assoc 11 line)))
		(setq koord_line_2 (mapcar '+ koord_line (list 0 -10)));координата нижней точки
		(setq x2 (nth 0 koord_line));Х верхней точки
		(setq y2 (nth 1 koord_line));Y верхней точки 
		(setq y_c (- y2 5)); Y середины отрезка
		
		(command "_.layer" "_set" "0" \e); сделать слой "0" текущим
		(command "_line" koord_line koord_line_2 ""); строим отрезок по верхней и нижней точкам в слое "0"
		(setq el_pr (ssget "_X" '((0 . "LINE") (8 . "Слой_2")))); создаем набор элементов из линий слоя эл.профиля
		(setq j 0)
			(while (< j (sslength el_pr)
				(setq el_pr_obj (ssname el_pr j))
				(setq el_pr_sv (entget el_pr_obj))
				(setq koord_el (cdr (assoc 10 el_pr_sv))); координата верхней точки отрезка
				(setq x_koord_el (nth 0 koord_el)); Х верхней точки отрезка
				(setq y_koord_el (nth 1 koord_el)); Y верхней точки отрезка
				
					(if (and (> (- x_koord_el x2) 0) (= y_koord_el y2)); если разница по X двух точек больше 0 и Y-ки равны, то:
						(progn
							(setq dist (- x_koord_el x2)); вычисление расстояния между отрезками
							(setq x_c (/ dist 2)); середина между отрезками
							(setq koord_txt (list x_c y_c)); координата середины между отрезками
							(command "_.text" koord_txt "0" "текст"); создание текста посередине между отрезками
							(setq tekst (entlast))
							(setq old_tekst (entget tekst))
							(setq old_tekst (subst (cons 1 dist) (assoc 1 old_tekst) old_tekst))
							;(setq old_tekst (subst (cons 8 "ОСЬ") (assoc 8 old_tekst) old_tekst))
							(entmod old_tekst)
						)
					)
				(setq j (+ 1 j))
			)		
		(setq i (+ 1 i))
	)

В прилагаемом файле то, что должно получится, находится в слое 0.

На данном этапе без проблем получается построить отрезки длиной 10 единиц в слое 0.

[Do$]

А в чем вопрос-то?

[nynokne]

Сообщение от Do$ А в чем вопрос-то?

Код, который написал, не работает.

[Кулик Алексей aka kpblc]

В каком месте не работает?

----- добавлено через ~31 мин. -----
Короче, голову ломать лениво, писать красивый код - тоже. Уж про объяснения молчу (просто работать немного лениво)

Код:

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

 (vl-load-com)

(defun test (/ ss pt ent_line near text adoc)
  (if (= (type (setq ss (vl-catch-all-apply
                          (function
                            (lambda ()
                              (ssget "_X" '((0 . "LINE") (8 . "Слой_1")))
                              ) ;_ end of lambda
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
    (progn
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (foreach ent1 ((lambda (/ tab item)
                       (repeat (setq tab  nil
                                     item (sslength ss)
                                     ) ;_ end setq
                         (setq tab (cons (ssname ss (setq item (1- item))) tab))
                         ) ;_ end of repeat
                       ) ;_ end of lambda
                     )
        (setq ent_line (entmakex (list (cons 0 "LINE")
                                       (cons 10
                                             (setq pt (car (vl-sort (mapcar (function cdr)
                                                                            (vl-remove-if-not
                                                                              (function
                                                                                (lambda (x)
                                                                                  (member (car x) '(10 11))
                                                                                  ) ;_ end of lambda
                                                                                ) ;_ end of function
                                                                              (entget ent1)
                                                                              ) ;_ end of vl-remove-if-not
                                                                            ) ;_ end of mapcar
                                                                    (function (lambda (a b) (< (cadr a) (cadr b))))
                                                                    ) ;_ end of vl-sort
                                                           ) ;_ end of car
                                                   ) ;_ end of setq
                                             ) ;_ end of cons
                                       (cons 11 (list (car pt) (- (cadr pt) 10.) (caddr pt)))
                                       (cons 8 "Adds")
                                       ) ;_ end of list
                                 ) ;_ end of entmakex
              near     (car (vl-sort (apply
                                       (function
                                         (lambda (ss / tab item)
                                           (repeat (setq tab  nil
                                                         item (sslength ss)
                                                         ) ;_ end setq
                                             (setq tab (cons
                                                         (ssname ss (setq item (1- item)))
                                                         tab
                                                         ) ;_ end of cons
                                                   ) ;_ end of setq
                                             ) ;_ end of repeat
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                       (list (ssget "_X" '((0 . "LINE") (8 . "Слой_2"))))
                                       ) ;_ end of apply
                                     (function (lambda (a1 b1)
                                                 (< (distance pt
                                                              (car (vl-sort (mapcar (function cdr)
                                                                                    (vl-remove-if-not
                                                                                      (function
                                                                                        (lambda (x)
                                                                                          (member (car x) '(10 11))
                                                                                          ) ;_ end of lambda
                                                                                        ) ;_ end of function
                                                                                      (entget a1)
                                                                                      ) ;_ end of vl-remove-if-not
                                                                                    ) ;_ end of mapcar
                                                                            (function (lambda (a b) (> (cadr a) (cadr b))))
                                                                            ) ;_ end of vl-sort
                                                                   ) ;_ end of car
                                                              ) ;_ end of distance
                                                    (distance pt
                                                              (car (vl-sort (mapcar (function cdr)
                                                                                    (vl-remove-if-not
                                                                                      (function
                                                                                        (lambda (x)
                                                                                          (member (car x) '(10 11))
                                                                                          ) ;_ end of lambda
                                                                                        ) ;_ end of function
                                                                                      (entget b1)
                                                                                      ) ;_ end of vl-remove-if-not
                                                                                    ) ;_ end of mapcar
                                                                            (function (lambda (a b) (> (cadr a) (cadr b))))
                                                                            ) ;_ end of vl-sort
                                                                   ) ;_ end of car
                                                              ) ;_ end of distance
                                                    ) ;_ end of <
                                                 ) ;_ end of lambda
                                               ) ;_ end of function
                                     ) ;_ end of vl-sort
                            ) ;_ end of car
              ) ;_ end of setq
        (entmakex
          (list (cons 0 "TEXT")
                (cons 100 "AcDbEntity")
                (cons 8 "distText")
                (cons 100 "AcDbText")
                (cons 10
                      (setq pt
                             (mapcar
                               '(lambda (a b) (* 0.5 (+ a b)))
                               pt
                               (car (vl-remove-if
                                      '(lambda (x) (= (cadr x) (cadr pt)))
                                      (mapcar 'cdr (vl-remove-if-not '(lambda (x) (member (car x) '(10 11))) (entget near)))
                                      ) ;_ end of vl-remove-if
                                    ) ;_ end of car
                               ) ;_ end of mapcar
                            ) ;_ end of setq
                      ) ;_ end of cons
                (cons 11 pt)
                (cons 71 0)
                (cons 72 1)
                (cons 1
                      (rtos (abs (- (cadr (assoc 10 (entget near)))
                                    (cadr (assoc 10 (entget ent_line)))
                                    ) ;_ end of -
                                 ) ;_ end of abs
                            2
                            4
                            ) ;_ end of rtos
                      ) ;_ end of cons
                (cons 40
                      (if (equal 0. (cdr (assoc 40 (entget (tblobjname "style" (getvar "textstyle"))))) 1e-3)
                        (getvar "textsize")
                        (cdr (assoc 40 (entget (tblobjname "style" (getvar "textstyle")))))
                        ) ;_ end of if
                      ) ;_ end of cons
                (cons 100 "AcDbText")
                (cons 73 2)
                ) ;_ end of list
          ) ;_ end of entmakex
        ) ;_ end of foreach
      (vla-endundomark adoc)
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun