[gizmo_zx]

Есть известная программа для нумерации блоков, все вней класс, но приоритеты нумерации мне нужны другие: она нумерует 1слева- напрвво, 2сверху-вниз, а мне надо чтоб сначала сверху-вниз, а уж потом слева на право. Думаю там только в циклах надо переменные местами поменять, но в программировании не силен...

программа:

Код:

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

(defun c:xblocknum (/ testf name tag pref suff num ss el lstins ssd eld index)

  ;; функция вернет T, если координата X первого аргумента меньше координаты X второго
  (defun testf (a b /)
    (< (cadr (assoc 10 (entget a))) (cadr (assoc 10 (entget b))))
  ) ;_  defun
; ***
(setq name0 (getstring "\nИмя блока:[Автомат1] "))
(if (= name0 "")(progn (setq name1 "Автомат1") (setq pref "")(setq suff "") )
			  (progn (setq name1 name0)(setq pref (getstring "\nПрефикс: ")) (setq suff (getstring "\nСуффикс: ")) )
)

(setq tag0 "num")
; ***

  (while (= (setq name name1) ""))
  (while (= (setq tag tag0) ""))
  (setq tag (strcase tag))

  (if (null (setq num (getint "\nСтартовый номер <1>: ")))
    (setq num 1)
  ) ;_  if

  (princ "\nБлоки > ")
  (if (setq ss (ssget (list '(0 . "INSERT") '(410 . "Model") (cons 2 name)))) ;_ набор от пользователя
    (progn

      ;; преобразование набора в список и удаление дубликатов блоков
      (while (> (sslength ss) 0)
        (setq ss (ssdel (setq el (ssname ss 0)) ss))
        (setq lstins (cons el lstins)) ;_ список INSERT'ов
        ;; поиск дубликатов в Модели
        (setq ssd (ssget "_X" (list '(0 . "INSERT") '(410 . "Model") (cons 2 name) (assoc 10 (entget el))))) ;_ только идеально совпадающие
        (if (> (sslength (ssdel el ssd)) 0) ;_ из набора дубликатов удаляем рабочий INSERT
          (while (> (sslength ssd) 0)
            (setq ssd (ssdel (setq eld (entdel (ssname ssd 0))) ssd)) ;_ удаление из чертежа и из набора найденных дубликатов
            (ssdel eld ss) ;_ удаление из набора пользователя
          ) ;_  while
        ) ;_  if
      ) ;_  while

      (setq index (vl-sort-i lstins 'testf)) ;_ индекс, упорядоченный тест-функциией

      (while index
        (setq el (nth (car index) lstins))
        ;; поиск нужного атрибута
        (while (and (/= (cdr (assoc 0 (entget el))) "SEQEND") (/= (cdr (assoc 2 (entget el))) tag))
          (setq el (entnext el))
        ) ;_  while

        ;;  если атрибут найден
        (if (= (cdr (assoc 2 (entget el))) tag)
          (progn
            (vla-put-textstring (vlax-ename->vla-object el) (strcat pref (rtos num 2 0) suff))
            (setq num (1+ num)) ;_ приращение номера
          ) ;_  progn
        ) ;_  if
        (setq index (cdr index))
      ) ;_  while

    ) ;_  progn
  ) ;_  if
  (princ)
) ;_  defun
(vl-load-com)

[sasha_lif]

подскажите как работает , что должно быть в блоке (атрибуты?)

[Alaspher]

Сообщение от gizmo_zx ...мне надо чтоб сначала сверху-вниз, а уж потом слева на право...

Так?

Код:

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

(defun c:xblocknum1 (/ testf name tag pref suff num ss el lstins ssd eld index)
  (defun testf (a b / ea eb)
    (setq ea (assoc 10 (entget a))
          eb (assoc 10 (entget b))
    )
    (or (> (caddr ea) (caddr eb))
        (and (= (caddr ea) (caddr eb)) (< (cadr ea) (cadr eb)))
    )
  )
  (if (= (setq name0 (getstring "\nИмя блока:[Автомат1] ")) "")
    (setq name1 "Автомат1"
          pref  ""
          suff  ""
    )
    (setq name1 name0
          pref  (getstring "\nПрефикс: ")
          suff  (getstring "\nСуффикс: ")
    )
  )
  (setq tag0 "num"
        name name1
        tag  (strcase tag0)
  )
  (if (null (setq num (getint "\nСтартовый номер <1>: ")))
    (setq num 1)
  )
  (princ "\nБлоки > ")
  (if (setq ss (ssget (list '(0 . "INSERT") '(410 . "Model") (cons 2 name))))
    (progn
      (while (> (sslength ss) 0)
        (setq ss (ssdel (setq el (ssname ss 0)) ss))
        (setq lstins (cons el lstins))
        (setq ssd
               (ssget "_X"
                      (list '(0 . "INSERT") '(410 . "Model") (cons 2 name) (assoc 10 (entget el)))
               )
        )
        (if (> (sslength (ssdel el ssd)) 0)
          (while (> (sslength ssd) 0)
            (setq ssd (ssdel (setq eld (entdel (ssname ssd 0))) ssd))
            (ssdel eld ss)
          )
        )
      )
      (setq index (vl-sort-i lstins 'testf))
      (while index
        (setq el (nth (car index) lstins))
        (while (and (/= (cdr (assoc 0 (entget el))) "SEQEND")
                    (/= (cdr (assoc 2 (entget el))) tag)
               )
          (setq el (entnext el))
        )
        (if (= (cdr (assoc 2 (entget el))) tag)
          (progn
            (vla-put-textstring (vlax-ename->vla-object el) (strcat pref (rtos num 2 0) suff))
            (setq num (1+ num))
          )
        )
        (setq index (cdr index))
      )
    )
  )
  (princ)
)
(vl-load-com)

Не вдавался в детали, только поменял алгоритм сортировки и исправил откровенный косяк. Имя функции изменил, воизбежание конфликта имён.

[Holon]

Можно поподробней как эта програмка считает блоки, я открыл новый файл создал там блок из двух примитивов,
назвал его 1 , потом вставил его здесь же пять раз и запустил xblocknum1 резултат:
Select objects: 0 found

Select objects: Specify opposite corner: 0 found
Select objects: 0 found, 0 total

Select objects: 0 found, 0 total

Select objects: 0 found, 0 total

Select objects: 0 found, 0 total

Select objects: 0 found, 0 total

Select objects: Specify opposite corner: 0 found, 0 total

Select objects: Specify opposite corner: 0 found, 0 total

[Holon]

Попробовал взял рамку с атрибутами тоже ничего несщитает

Command: _.eattedit
Select a block: 204.076019,15.729530,-3.471080
Command: Specify opposite corner:
Command: 'VLIDE
Command:

[Alaspher]

Holon
Блок (по умолчанию, с именем "Автомат1") должен иметь трибут с тэгом - "num".