Проблема с автонумерацией блоков с аттрибутами

X-DeViL · 23.06.2006, 12:04

Имеется динамический блок. Имеется LISP:

Код:

(defun c:pickblocknum (/ name tag pref suff num ss el)
  (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Стартовый номер: ")))
    (setq num 1)
  ) ;_  if

  (princ "\nБлоки > ")
  (if (setq ss (ssget (list '(0 . "INSERT") '(410 . "Model") (cons 2 name))))
    (while (> (sslength ss) 0)
      (setq ss (ssdel (setq el (ssname ss 0)) ss))
      ;; поиск нужного атрибута
      (while (and (/= (cdr (assoc 0 (entget el))) "SEQEND")
                  (/= (cdr (assoc 2 (entget el))) tag)
             ) ;_  or
        (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
    ) ;_  while
  ) ;_  if
  (princ)
) ;_  defun
(vl-load-com)

;;;(c:pickblocknum) ;_ автозапуск

Все вроде работает нормально до того момента когда надо "выбрать блоки"... а дальше этот лисп их даже не выбирает... Автокад 2007...

Кулик Алексей aka kpblc · 23.06.2006, 12:28

Попробуй отсюда и http://dwg.ru/dwl/70]отсюда. Вроде как нормально работают... В показанном коде вроде как ничего особо криминального нет...
Или покажи файлик с блоком - может, проблема именно в том, что блок динамический, и там не все так просто.

X-DeViL · 23.06.2006, 12:55

Твой лисп пашет.. спасибо... тема закрыта.

X-DeViL · 23.06.2006, 15:00

СТОП! ДАННЫЙ ЛИСП НЕ ПАШЕТ если в динамическом блоке изменены параметры, по сравнению с оригиналом...

Кулик Алексей aka kpblc · 23.06.2006, 17:05

Случилось то, о чем я предупреждал - динамические блоки с точки зрения лиспа являются анонимными

Со всеми вытекающими. Лови:

Код:

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

(defun c:renumblock (/ ent selset item prefix suffix number att_item)
  (vl-load-com)
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (if
    (and (setq
	   ent (nentsel
		 "\nУкажите атрибут блока, который надо переделывать <Выход> : "
		 ) ;_ end of nentsel
	   ) ;_ end of setq
	 (= (cdr (assoc 0 (entget (setq ent (car ent))))) "ATTRIB")
	 ) ;_ end of and
     (progn
       (initget "Да Нет Yes No _ Y N Y N")
       (if
	 (not (setq
		answer (getkword
			 "\nУчитывать старые значения атрибутов [Да/Нет] <Да> : "
			 ) ;_ end of GETKWORD
		) ;_ end of setq
	      ) ;_ end of not
	  (setq answer "Y")
	  ) ;_ end of if
       (setq prefix (getstring t "\nПрефикс нумерации : ")
	     suffix (getstring t "\nСуффикс нумерации : ")
	     selset (ssget '((0 . "INSERT") (66 . 1)))
	     ) ;_ end of setq
       (if (not (setq number (getint "\nСтартовый номер <1> : ")))
	 (setq number 1)
	 ) ;_ end of if
       (foreach	item
		(mapcar	'vlax-ename->vla-object
			(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
			) ;_ end of mapcar
	 (if (setq att_item
		    (vl-remove-if-not
		      '(lambda (x)
			 (= (strcase (vla-get-tagstring x) t)
			    (strcase
			      (vla-get-tagstring (vlax-ename->vla-object ent))
			      t
			      ) ;_ end of strcase
			    ) ;_ end of =
			 ) ;_ end of LAMBDA
		      (vlax-safearray->list
			(vlax-variant-value
			  (vla-getattributes item)
			  ) ;_ end of vlax-variant-value
			) ;_ end of vlax-safearray->list
		      ) ;_ end of VL-REMOVE-IF-NOT
		   ) ;_ end of setq
	   (progn
	     (vla-put-textstring
	       (car att_item)
	       (strcat prefix
		       (rtos number 2)
		       suffix
		       (if (= answer "Y")
			 (vla-get-textstring (car att_item))
			 ""
			 ) ;_ end of if
		       ) ;_ end of strcat
	       ) ;_ end of vla-put-TextString
	     (setq number (1+ number))
	     ) ;_ end of progn
	   ) ;_ end of if
	 ) ;_ end of while
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
  ) ;_ end of defun

Проверь, по-моему, работает.

Лентяй · 24.06.2006, 06:58

Как увижу kpblc'овский LISP, как обычно - не могу молчать [sm2001].
Во-первых, что за смешение язЫков. Я имею в виду не LISP c ActivwX (как обычно), но комментрарии.
А во вторых - с каких пор порядковый номер блока - реальное число? [sm2100] КМК, оно всегда было целым. А посему - вариант исправленный и дополненный.
1. Все сделано средствами ActiveX (как обычно).
2. Введена проверка совпадениея имен блоков образца и набора.
3. Имправлен описание номера блока.

Код:

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

(defun c:renumblock (/ adoc ass util answer sob psfix number) 
  (vl-load-com) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)));setq
  (mapcar '(lambda (x y) (set x (vlax-get-property adoc y))) '(ass util)
    '(ActiveSelectionset Utility))
  (if (> (vla-get-count ass) 0) (vla-clear ass))
  (vla-startundomark adoc)
  (vla-initializeUserInput util 128 "Да Нет")
  (setq answer (vla-getkeyword util "\nУчитывать старые значения атрибутов [Да/Нет] <Да> : "))
  (if (= "" answer) (setq answer "Да"))
  (vla-getSubentity util 'sob nil nil nil "\nУкажите атрибут блока, который надо переделывать")
  (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
             (setq number (vla-getInteger util "\nСтартовый номер <1> : "))))) (setq number 1))
  (vla-SelectOnScreen ass (vlax-safearray-fill (vlax-make-safearray vlax-vbInteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 0)) (list "*Insert")))
  (setq psfix (mapcar '(lambda (x) (getstring t (strcat "\n" x " нумерации : ")))
                '("Префикс" "Суффикс")))
  (vlax-for sb ass 
    (foreach item (vlax-invoke sb 'Getattributes)
      (if (apply '= (mapcar '(lambda (x y) (vlax-get-property x y))
                      (list sob item) '(name TagString))) 
        (progn (vla-put-textstring item
               (strcat (car psfix) (itoa number) (cadr psfix))
                 (if (= answer "Да") (vla-get-textstring item) "" ))
             (setq number (1+ number))))));vlax-for
  (vla-endundomark adoc) 
  (princ) 
  );end

Дожно работать. (Я так думаю)[sm2001].

X-DeViL · 26.06.2006, 15:19

Код:

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

vla-SelectOnScreen ass

По фрейду

)) в переводе с англицкого

Кулик Алексей aka kpblc · 26.06.2006, 15:24

Ты погоди переводить, лучше скажи, работает или нет

X-DeViL · 26.06.2006, 15:30

Не пашет!

Код:

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

; error: ActiveX Server returned the error: unknown name: NAME

Кулик Алексей aka kpblc · 26.06.2006, 15:37

А поконкретнее? Чей не работает? Мой или Лентяя код?

X-DeViL · 26.06.2006, 18:29

kpblc

Твой код последний пашет... но только с НЕМОДИФИЦИРОВАННЫМИ динамическими блоками...

Лентяй

Выдает ошибку после запроса всех параметров

Код:

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

; error: ActiveX Server returned the error: unknown name: NAME

Лентяй · 26.06.2006, 23:34

Цитата:

Сообщение от X-DeViL

Лентяй
Выдает ошибку после запроса всех параметров

Код:

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

; error: ActiveX Server returned the error: unknown name: NAME

Сорры, немношка перепутал блоки с атрибутами. Часть (vlax-for...);vlax-for должна выглядеть так:

Код:

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

(vlax-for sb ass
    (if (apply '= (mapcar '(lambda (x) (vla-get-name x))
                    (list sb (vla-ObjectIDToObject adoc (vla-get-OwnerID sob)))))
      (foreach item (vlax-invoke sb 'Getattributes)
        (if (apply '= (mapcar '(lambda (x) (vla-get-TagString x)) (list sob item)))
          (progn (vla-put-textstring item
               (strcat (car psfix) (itoa number) (cadr psfix)
                 (if (= answer "Да") (vla-get-textstring item) "" )))
             (setq number (1+ number)))))));vlax-for

VolSilm · 31.07.2013, 16:19

Здравствуйте!
Понимаю, что совсем некропост, но...
уже 2 дня рыскаю по форуму в поисках простого нумератора блоков для нумерации страниц в штампах (в виде динамического блока). До этого пользовался autonumbering text текст-примитивов в отдельном слое
перебрал anshl, renumA, pickblocknum, bincA. Больше всего подошел приведенный на этой странице код, но работает он не совсем так, как хотелось бы. Если тыкать индивидуально каждый блок, то все ништяк (нумерует слева направо). А если выделять рамкой (как "жадной", так и не "жадной"), то нумерация всегда идет справа налево.
Не подскажете, чего бы такое сюда добавить, чтобы либо направление нумерации зависело от выделения, либо чтобы можно было выбирать в диалоге направление нумерации? Заранее благодарен

На всякий случай,, привожу используемый код:

Код:

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

 
01    (defun c:renumblock (/ adoc ass util answer sob psfix number)
02      (vl-load-com)
03      (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)));setq
04      (mapcar '(lambda (x y) (set x (vlax-get-property adoc y))) '(ass util)
05        '(ActiveSelectionset Utility))
06      (if (> (vla-get-count ass) 0) (vla-clear ass))
07      (vla-startundomark adoc)
08      (vla-initializeUserInput util 128 "Да Нет")
09      (setq answer (vla-getkeyword util "\nУчитывать старые значения атрибутов [Да/Нет] <Да> : "))
10      (if (= "" answer) (setq answer "Да"))
11      (vla-getSubentity util 'sob nil nil nil "\nУкажите атрибут блока, который надо переделывать")
12      (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
13                 (setq number (vla-getInteger util "\nСтартовый номер <1> : "))))) (setq number 1))
14      (vla-SelectOnScreen ass (vlax-safearray-fill (vlax-make-safearray vlax-vbInteger '(0 . 0)) '(0))
15        (vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 0)) (list "*Insert")))
16      (setq psfix (mapcar '(lambda (x) (getstring t (strcat "\n" x " нумерации : ")))
17                    '("Префикс" "Суффикс")))
18    (vlax-for sb ass
19        (if (apply '= (mapcar '(lambda (x) (vla-get-name x))
20                        (list sb (vla-ObjectIDToObject adoc (vla-get-OwnerID sob)))))
21          (foreach item (vlax-invoke sb 'Getattributes)
22            (if (apply '= (mapcar '(lambda (x) (vla-get-TagString x)) (list sob item)))
23              (progn (vla-put-textstring item
24                   (strcat (car psfix) (itoa number) (cadr psfix)
25                     (if (= answer "Да") (vla-get-textstring item) "" )))
26                 (setq number (1+ number)))))));vlax-for
27      (vla-endundomark adoc)
28      (princ)
29      );end

З.Ы. Вообще код очень странно работает (что kpblc'a, что Лентяя). Нумерует первый элемент, второй элемент нумерует последней цифрой из ряда и дальше по убывающей (пример: всего 11 элементов, 1-му присваивается №1, 2-му №11, 3-му №10...11-му №2)
Пока что пользуюсь anshl с этого форума
Но был бы благодарен за доработку именно этого кода - для меня он в работе удобней, похож в использовании на инструмент autonumbering text из express tools.