[beeliy]

Здравствуйте! Помогите пожалуйста найти ошибку в коде. В програмировании я начинающий. Ситуация следующая. есть объекты (полилинии) замкнутые в контур, таких полилиний много, в каждом контуре стоит номер ("123" или "65а" например). Моя задача на данном этапе связать (ассоциировать) контур с номером. В этом куске кода нужно получить два списка, 1-й (номер1 номер2 номер3 номер4 .........) и 2-й ((номер1 имяОбекта1) (номер2 имяОбекта2) (номер3 имяОбекта3) .........)
Проблема: если в набор включить один контур код полностью выполняется, но если несколько то код останавливается на строчке
(setq nab2 (ssget "_W" minp maxp '((0 . "TEXT"))))
В реальном файле контуры расположены на линии (полилиния). замечено что код также выполняется, если контуры снять с линии.

картинки https://plus.google.com/photos/11298...COWO-ZycsdS-Eg

Ну и если есть общие замечания по коду, будет интересно узнать.

Код:

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

  (vl-load-com)
    (setq act (vla-get-ActiveDocument (vlax-get-acad-object)))
    (setq obj (vla-get-ModelSpace act))
  (setq kil1 (sslength (setq nab1 (ssget '((0 . "LWPOLYLINE")))
			   )
		     )
      )
  (setq numb_op_list (list ()))
  (setq numb_op_and_name_list (list (list ())))
  (setq kil2 0)
  (while (< kil2 kil1)
    (setq im1 (ssname nab1 kil2))
    (setq im1_vla (vlax-ename->vla-object im1))
    (vla-put-elevation im1_vla 0.0)
    (vla-getboundingbox im1_vla 'minp 'maxp)
    (setq minp (vlax-safearray->list minp))
    (setq maxp (vlax-safearray->list maxp))
    (setq minp (mapcar '+ minp (list -1 -1)))
    (setq maxp (mapcar '+ maxp (list 1 1)))
    (setq nab2 (ssget "_W" minp maxp '((0 . "TEXT"))))
    (if (/= nab2 nil)
      (setq numb_op (vla-get-TextString (vlax-ename->vla-object (ssname nab2 0))))
      (setq numb_op "pust")
      )
    (setq numb_op_list (cons numb_op numb_op_list))
    (setq numb_op_and_name_list (cons (list numb_op im1) numb_op_and_name_list))
    (setq kil2 (1+ kil2))
    );end while
  (setq numb_op_list (vl-remove "pust" numb_op_list))
  (setq numb_op_list (acad_strlsort (vl-remove nil numb_op_list)))

[Дима_]

Сообщение от beeliy Ну и если есть общие замечания по коду, будет интересно узнать.

Ну начнем с логики - а если один контур в другом - кому принадлежит номер? а если номеров (текстов) несколько внутри одного контура, по коду:
Не локализованны переменные, последовательные setq лучше объединять в один, строка 8-9 - это вобще шедевр - где Вы такое увидили, в коде по факту ищется не внутри контура а внутри прямоугольника описываемого контуром, да еще и рисунок физически меняется (vla-put) - а надо было "посчитать" - это как-то не правильно.
Для начала неплохо, но лично меня от такого стиль лисп программ передергивает - в лиспе по-правильному делается не так как в "классическом" прграммировании - иначе "профита" от него никакого нет - а только геморой - вот твой пример (только с подправленной логикой) - выдает список списков - (контур тексты...) - смотрит только замкнутые полилинии (что не есть правда для всех как-бы замкнутых в твоем примере) и написанный в лисп стиле - сможешь разбраться - так и пиши - непонятных ошибок станет в 45 раз меньше - я гарантирую:

Код:

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

 (vl-load-com)
(defun test()
  ((lambda (sstolist cod) 
     (vl-remove-if-not '(lambda (x) (cdr x))
        (mapcar '(lambda (ent)
                (cons (cod -1 ent)
                      (mapcar '(lambda (txt) (cod 1 (entget txt)))
                                  (sstolist (ssget "_WP"
                                             (mapcar '(lambda (x) (trans (reverse (cons (cod 38 ent )(reverse (cdr x)))) (cod 210 ent) 0))
                                                     (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent))
                                             '((0 . "*TEXT")))))))
             (mapcar 'entget (sstolist (ssget '((0 . "LWPOLYLINE") (70 . 1))))))))
   (lambda (ss)
     (if ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
   (lambda (cod lst) (cdr (assoc cod lst)))))

если надо чтоб проверял все-таки все полилинии (и не замкнутые) - то сотри (70 . 1) из строки 12

[beeliy]

Спасибо. С функцией lambda еще не розобрался. видимо мне это предстоит))