[G-RAV]

код по нумерации вершин полилиний в замкнутых полигонах и создании списка listen, где при совпадении вершин полигонов сохраняется первоначальный номер:

Код:

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

(defun C:Katalog (/ object katalog X1 Y1 l1st listen insert)
  (setq	old_cmdecho (getvar "cmdecho")
	old_osmode  (getvar "osmode")
  )

  (setvar 'cmdecho 0)
  (setvar 'osmode 0)

  (vl-load-com)
  (setq	object (ssget "_:s" '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))
	NN     1
  )

  (command "_style" "Standart" "" "1" "" "" "" "_n" "_n")

  (while (/= object nil)
    (setq object (vlax-ename->vla-object (ssname object 0)))
    (vlax-dump-object object)
    (setq katalog (safearray-value
		    (vlax-variant-value (vla-get-coordinates object))
		  )
    )
    (setq nomer	1
	  l1st nil
    )
    (repeat (/ (length katalog) 2)
      (setq X1 (nth (1- nomer) katalog)
	    Y1 (nth nomer katalog)
      )
      (setq SS NN)
      (if (/= listen nil)
	(progn
	  (setq k 0)
	  (while (/= (nth k listen) nil)
	    (setq z 0)
	    (while (/= (nth z (nth k listen)) nil)
	      (if (and (= X1 (cadr (nth z (nth k listen))))
		       (= Y1 (caddr (nth z (nth k listen))))
		  )
		(setq NN     (car (nth z (nth k listen)))
		      insert 1
		      SS (1- SS)
		)
	      )
	      (setq z (1+ z))
	    )
	    (setq k (1+ k))
	  )
	)
      )
      (if (/= insert 1)
	(command "_circle"
		 (list X1 Y1)
		 0.5
		 "_text"
		 (polar (list X1 Y1) 0 0.7)
		 "0"
		 NN
	)
      )
      (setq l1st   (cons (list NN X1 Y1) l1st)
	    NN	   SS
	    nomer  (+ nomer 2)
	    NN	   (1+ NN)
	    insert nil
      )
    )
    (setq listen (cons l1st listen)
	  object (ssget "_:s" '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))
    )

  )
  (print listen)
  (setvar 'cmdecho old_cmdecho)
  (setvar 'osmode old_osmode)
)

Меня интересует выделенная красным цветом часть кода... какие еще могут быть варианты без использования while

[Лиспер]

Для получения координат, мне кажется, проще будет использовать код наподобие:

Код:

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

(setq object (ssname (ssget "_:s" '((0 . "LWPOLYLINE") (70 . 1))) 0)
      coords (mapcar (function cdr) (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget object)))
      ) ;_ end of setq

Остальной код не смотрел.

[VVA]

Я с кодом не разбирался. Альтернатива while - repeat и mapcar. Данные хранятся в списках. По поводу нумерации: мне кажется ты изобретаешь велосипед.
Посмотри эту тему и попробуй команды в постах #7 ;#22 ; #24
А так же
Экспорт координат выбранных объектов из AutoCAD в *.txt
Импорт координат из текстового фала txt (sdr) в AutoCAD

[G-RAV]

2 VVA
Да я вот и пытаюсь избавиться от склонности изобретать велосипед... Нумерация просто в качестве примера (знаю, что таких программ пруд пруди)...

[Disney]

Сообщение от VVA Альтернатива while - repeat и mapcar

можно ещё добавить foreach

G-RAV, посмотри коды из темы Как пронумеровать атрибуты?, правда там были блоки, вместо твоих кружочков с текстом, но суть та же

[Li6-D]

Сообщение от G-RAV Меня интересует выделенная красным цветом часть кода... какие еще могут быть варианты без использования while

В данном случае лучше использовать foreach:

Код:

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

      (foreach k listen
        (foreach z k
          (if (and (= X1 (cadr z)) (= Y1 (caddr z)))
            (setq NN (car z)
                  insert 1
                  SS (1- SS)
            )
          )
        )
      )