Программа для нумерации пожарных извещателей (Страница 1 из 3)

> Любознательный
Не стОит путать понятия... Это всего лишь набросок, хотя и вполне рабочий.
НО!
1. Из трех известных типов полилиний понимает только LWPOLYLINE;
2. Имена блоков прописаны в программе (может быть, удобнее когда ткнул в образец блока - и счет по ним пойдет, но тогда стопудово нужна проверка на наличие атрибутов);
3. Нет проверки на блокировку слоя атрибута;
4. Не реализованы точки отката для UNDO;
5. Скорей всего должен быть опциональный выбор сквозной/индивидуальной нумерации, как и выбор метода "по блокам" / "по вершинам";
6. Возможность задания начального значения для подсчета неплохо было бы иметь;
7. А полностью рабочего кода то и нет. Потому как требования разные.... Конструктор "Сделай сам" какой то получился ))
Это так, на вскидку... чего не хватает тому что лежит по ссылке до того чтоб назваться программой. А точнее - командой. Профессиональные программисты наверняка еще что нибудь вспомнят, документацию, например

Уважаемый VK!
Аппетит приходит во время еды. Хочу просить Вас расширить возможности Вашей ЛИСП-команды lwsvertnum (или какой другой) для решения такой задачи. В схеме автоматизации технологических процессов необходимо пронумеровать ряд блоков, представляющих собой условное графическое обозначение приборов, линий связи и пр. ЛИСП-команда будет запускаться из меню, поэтому ей будет передаваться имя блока и имя атрибута для нумерации. Далее нужно поступить двояко.
Первое яко. Блоки разбросаны по чертежу в произвольном порядке. Пользователь последовательно указывает блоки в том порядке, в каком ему нужно их пронумеровать - ЛИСП-команда в нужные атрибуты проставляет значение n+1, n - запросить, по умолчанию n=1, умолчание подтверждать Enter или Пробелом.
Второе яко. Блоки находятся в т.н. подвале схемы, с одинаковой координатой Y точки вставки. Пользователь выполняет множественный выбор, заканчивает его Enter - ЛИСП-команда в выбранные блоки слева направо (начиная с блока с меньшей координатой Х точки вставки) в нужные атрибуты проставляет значение n+1, n - запросить, по умолчанию n=1, умолчание подтверждать Enter или Пробелом.
Имеющиеся значения атрибутов игнорировать. Имеющиеся дубликаты блоков с одинаковой координатой Х точки вставки (для второго яко) игнорировать (заполнять только один), если не влом - дубликаты удалить.
Не знаю, как Вас и благодарить! Хотя, говорят, с тех пор, как человечество выдумало деньги, этот вопрос стал решаться значительно легче.

Подвал - это таблица в нижней части схемы автоматизации технологических процессов, в которой в упорядоченом виде сконцентрированы условные графические обозначения приборов и связи между ними.
Я так понимаю, что вероятность написания Вами таких команд для широкой общественности >0. Ждем-с!

На второе яко

(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
  (while (= (setq name (getstring "\nИмя блока: ")) ""))
  (while (= (setq tag (getstring "\nТег: ")) ""))
  (setq tag (strcase tag))
  (setq pref (getstring "\nПрефикс: "))
  (setq suff (getstring "\nСуффикс: "))
  (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)
(c:xblocknum) ;_ автозапуск

Тут есть немного непоняток. Конечно, обе проги предельно упрощены на предмет всяческих проверок.

Так это же команда - потому и из макроса к ней надо обрашаться как к команде, а не как к Лисп-функции. Потому просто передавайте аргументы как в обычную команду, разделяя их пробелами или ; (точкой с запятой). Кавычки не нужны, если нет пробелов в именах.
А в функцию, начинающуюся на c: нельзя передавать аргументы, если не ошибаюсь.

Можно. Надо в нужные места поставить (setvar "cmdecho" 0) и (setvar "cmdecho" 1).
Или попробовать в макросе ^P использовать.

Дак вроде параметры то макросом вводятся ) Если ну оччччень надо - то можно, тока в каких именно местах?

Все возможно... Нечто вроде этого

  (while  (setq ss ":S" (ssget (list '(0 . "INSERT") '(410 . "Model") (cons 2 name))))

и скобку лишнюю убрать... Но тут подумать надо, как организовать выход.

Привожу пример одной из программ с сокрытием курсора в нужном месте (только для модели!). Думаю, разберетесь куда что воткнуть в других прогах.

(defun c:xblocknum (/ *error* dpfr mbgc mcgc testf name tag pref suff num ss el lstins ssd eld index)
  (defun *error* (msg)
    (vla-put-ModelCrosshairColor dpfr mcgc) ;_ восстановление курсора
  )
  ;; функция вернет T, если координата X первого аргумента меньше координаты X второго
  (defun testf (a b /)
    (< (cadr (assoc 10 (entget a))) (cadr (assoc 10 (entget b))))
  ) ;_  defun
  (setq dpfr (vla-get-display (vla-get-preferences (vlax-get-acad-object))))
  (setq mbgc (vla-get-GraphicsWinModelBackgrndColor dpfr)) ;_ цвет background
  (setq mcgc (vla-get-ModelCrosshairColor dpfr)) ;_ текущий цвет курсора
  (while (= (setq name (getstring "\nИмя блока: ")) ""))
  (while (= (setq tag (getstring "\nТег: ")) ""))
  (setq tag (strcase tag))
  (setq pref (getstring "\nПрефикс: "))
  (setq suff (getstring "\nСуффикс: "))
  (vla-put-ModelCrosshairColor dpfr mbgc) ;_ сокрытие курсора
  (if (null (setq num (getint "\nСтартовый номер <1>: ")))
    (setq num 1)
  ) ;_  if
  (vla-put-ModelCrosshairColor dpfr mcgc) ;_ восстановление курсора
  (princ "\nБлоки > ")
.......

Функция *error* нужна для восстановления курсора при отказе пользователя от продолжения программы по ESC

И откуда же его брать? Анализировать все блоки в чертеже?
Да, вот еще... как насчет закрытия "дырок" в последовательности нумерации (например при удалении блока)?

Да не... вроде не должно быть заметных тормозов... просто уточнить ТЗ
Обдумаю, попробую сделать.

Command: (load "pickblocknum.lsp")
Command: pickblocknum
Имя блока: "SA_SIA1"
Тег: "POZ"
Префикс: ""
Суффикс: ""
Дырки: 67
Стартовый номер или [Next (72)] <1>:""
Requires an integer value or option keyword.
Стартовый номер или [Next (72)] <1>:next
Блоки >
Select objects: 1 found
Select objects: 1 found, 2 total
Select objects: 1 found, 3 total
Select objects: 1 found, 4 total
Select objects:
; error: bad argument type: numberp: "Next"
Command:
Это если ввожу "N" или "NEXT", ввод различных префиксов/суффиксов не влияет.
Где-то чего-то не хватает, или лишнее, сам не придумаю...
Если ввожу номер - все нормально.
Дырки считаются правильно. Нашел в своем чертеже ошибки. Спасибо!

Ну, конеччччно!

Все работает! Спасибо.
А это.. ну, как бы... мммм... вот если бы еще... не сочтите слишком назойливым...
Короче, если бы и дубликаты выдать, как дырки...

Извиняюсь, что вклинился в диалог...
Это все очень интересно и нужно...расскажите мне,новичку, как этим воспользоваться, применимо к AutoCad?