[Diman111]

Доброе время суток.
Ситуация:
есть набор блоков с изменяемым атрибутом. скажем - геометрический жлемент (круг) и рядом цифра - атрибут.
таких атрибутов на листе порядка 2 тыс. шт. требуется их все пронумеровать. т.е. дуб клик на блоке пишем 1; клик на другом- пишем 2 и т.д.
Просьба такая:
автоматизировать процесс следующим образом:
указываем начальную цифру нумерации - скажем 1;

выделяем набор блоков скажем слева на право жмем ентер и блоки нумеруются с лево на право;

выделяем набор блоков справо на лево жмем ентер и блоки нумеруются с право на лево;
(т.е. должен идти контроль по нумерации по оси х или y по желанию (в принципе и по х достаточно но для универсальности можно и по y));

и так повторяем пока все блоки не пронумеруем.
Выжеляем по 1 ряду.

Если не сложно помогите пожалуйста господа профи.
[ATTACH]1135575294.jpg[/ATTACH]
[ATTACH]1135575325.jpg[/ATTACH]

[sv_ispu]

express tools -> text -> automatic text numbering...
или посмотри на autocad.ru в форуме. Эта проблема стопудово обсуждалась...

[Alan]

>Diman111
Как раз по сваям делал
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=868uY

[Diman111]

Сообщение от Alan >Diman111 Как раз по сваям делал http://www.autocad.ru/cgi-bin/f1/board.cgi?t=868uY

К сожалению ссылка на не совсем бесплатную программу,
и прога имеет существенный недостаток - она не позволяет пробить все поле автоматически - приходится каждый раз указывать номер 1 - 10 -30 и т.д. менять направдение оси - по возрастанию или убыванию - в общем не совсем то но близко. для поля из 20-30 блоков подходяще.

може все же кто то сможет написать лисп а - господа программисты !!??

[fixo]

Если по-простому, попробуй так:

Код:

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

(defun C:SN (/ att ent num ss)
(setvar "attreq" 1)
(initget 6)
(setq num (getint "\n\tНачальный номер : "))
(setq ss (ssget (list (cons 0 "INSERT")
			(cons 2 "СВАЯ С1")
			(cons 66 1))))
     (if ss
     (progn
          (repeat (sslength ss)
          (setq ent (ssname ss 0))
          (setq en (entget ent))
          (setq sub1 (entnext ent))
          (setq suben (entget sub1))
               (while (/= (cdr (assoc 0 suben)) "SEQEND")
               (progn
               (setq ctag (cdr (assoc 2 suben)))
                    (if (= ctag "НОМЕР")
                    (progn
                    (entmod (subst (cons 1 (itoa num)) (assoc 1 suben) suben))
                    (entupd ent)
                    ))
               (setq sub1 (entnext sub1))
               (setq suben (entget sub1))
               )) 
          (ssdel ent ss)
	    (setq num (1+ num))
          )
     )
       )
  (setvar "attreq" 0)
  (princ)
  )
(prompt "\nВ командной строке набери SN \n")
(princ)

~'J'~

[Diman111]

Спасибо Fatty.
а если еще учесть направления выбора и проверять только ось X или Y на направление - по желанию.
т.е. если один блок выше другого по оси у а проверка идет по оси х то этот блок нумеруется вместе со всеми одинаково.
и поставить на цикл а выход например по вводу 0 (нуля).

надеюсь не обнаглел

[fixo]

Сообщение от Diman111 Спасибо Fatty. а если еще учесть направления выбора и проверять только ось X или Y на направление - по желанию. т.е. если один блок выше другого по оси у а проверка идет по оси х то этот блок нумеруется вместе со всеми одинаково. и поставить на цикл а выход например по вводу 0 (нуля). надеюсь не обнаглел

Это не сложно, но в данный момент не могу, если никто не поможет,
попозже вернусь

'J'~~

[Alan]

>Diman111

К сожалению ссылка на не совсем бесплатную программу,

По указанной ссылке http://www.autocad.ru/cgi-bin/f1/board.cgi?t=868uY я писал Alan (2003-03-15 13:01:01)
о возможности БЕСПЛАТНОЙ высылки текста.
Выбор свай делается рамкой или секрамкой. Я не очень сильный прогаммист, поэтому текст посылал тому кто запрашивал, а не размещал.
Дурь не хотел показывать. Ну уж ладно, размещаю

Код:

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

;*******************************************************************************
;*     Программа : ПАРКС
;*    - Функция замены атрибута
; Функция  для изменения номеров сваи
;*         / AutoCAD/  язык AutoLISP      Назаров А.А. 11.02.95-2002    *
;*******************************************************************************
 
 
 

 
(defun C:Chan_Numb (/ i	  j	  pbx	  jp	  sa1	  sa2
		  aa2	  sa3	  sa4	  sort	  att	  seqend
		  att_value	  value_new	  value
		 )
  ( grtext -1 "(C) А.Назаров 2000г. ")
   ( prompt "\n Укажите сваи для изменения номеров " )
           
             (setq i 0
		   jp 1
		   pbx ( getvar "pickbox" )

;;;;;;Составления списка на изменение
		   sa1
		    (ssget   )
;;;	можно  так	   
;;;		    (ssget       '((0 . "INSERT")))
	     )
  ( setvar "pickbox" 3)
(while (/= nil (ssname sa1 i))
      (setq aa3	(entget (ssname sa1 i))
      )
;;; Удаление лишних примитивов из набора
      (if (/= "INSERT" (cdr (assoc 0 aa3)))

	(progn
	  (ssdel (cdr (assoc -1 aa3)) sa1)
	)
	(progn
;;;		новый список примитивов
	  (setq sa2 (cons aa3 sa2))
	  (setq i (1+ i))
	)
      )
    )
    

  
      (setq i	0
	    aa2	(length sa2)
      )
	(repeat	aa2
	  (setq	aa3 (nth i sa2)
	  )

;;; Удаление лишних примитивов из набора
;;;	   Блоков много, но у меня имена блоков сваи начинаются с этих символов: s или c
;;;	   
	  (if (and (/= "c" (strcase (substr (cdr (assoc 2 aa3)) 1 1) T))
;;;		   (/= "C" (substr (cdr (assoc 2 aa3)) 1 1))
		   (/= "s" (strcase (substr (cdr (assoc 2 aa3)) 1 1) T))
;;;		   (/= "S" (substr (cdr (assoc 2 aa3)) 1 1))
	      )
	    (progn
	    )
	    (progn
;;;		новый список примитивов
	      (setq sa4 (cons aa3 sa4))

	    )
	  )
	  (setq i (1+ i))
	)				; конец while по ТИпаМ примитивов и СЛОЯМ
   (setq aa2  (length sa4)
	 i    0
	 j    (getint
		(strcat "\Введите начальный номер сваи <" (itoa jp) ">:")
	      )
	 j    (if j
		j
		jp
	      )
	 jp   j
	 sort (getstring
		"\Введите направление сортировки по оси Х и У <++>:"
	      )
	 sort (if (= "" sort)
		"++"
		sort
	      )
   )
(if (> aa2 1)
	(cond

;;;сортировка по возрастанию Х
	  ((= sort "++")
	   (setq sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (< (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
			 )
		       )
		     )
		 sa4
		     (vl-sort
		       sa4
		       (function (lambda (e1 e2)
				   (< (caddr (assoc 10 e1)) (caddr (assoc 10 e2)))
				 )
		       )
		     )
	   )
	  )
	  ((= sort "-+")
	   (setq sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (> (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
			 )
		       )
		     )
		 sa4
		     (vl-sort
		       sa4
		       (function (lambda (e1 e2)
				   (< (caddr (assoc 10 e1)) (caddr (assoc 10 e2)))
				 )
		       )
		     )
	   )
	  )
	  ((= sort "+-")
	   (setq sa4
		     (vl-sort
		       sa4
		       (function (lambda (e1 e2)
				   (> (caddr (assoc 10 e1)) (caddr (assoc 10 e2)))
				 )
		       )
		     )
		 sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (< (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
			 )
		       )
		     )
	   )
	  )
	  ((= sort "--")
	   (setq sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (> (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
			 )
		       )
		     )

		 sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (> (caddr (assoc 10 e1)) (caddr (assoc 10 e2)))
			 )
		       )
		     )
	   )
	  )
	);;; cond

  )
(if (> aa2 0)
(progn
              (setq i 0)
 (repeat aa2
    (setq aa3 (cdr (car (nth i sa4))))

     (setq att (entnext aa3))
      (setq seqend (cdr (assoc 0 (entget att))))
      (while (not (eq seqend "SEQEND"))
	(setq att_value	(cdr (assoc 1 (entget att)))
	      value_new	(itoa j)
	      value	(subst (cons 1 value_new)
			       (assoc 1 (entget att))
			       (entget att)
			)
	)
	(entmod value)
	(entupd att)
	(setq att (entnext att))
	(setq seqend (cdr (assoc 0 (entget att))))
      )					; end while
    (setq j (1+ j))
    (setq i (1+ i))
)
  )
)



(prompt (strcat "\n Заменены номера у "  (itoa i) " свай"))

	(redraw)
  ( setvar "pickbox" pbx)
 (princ)
 
)

[Alan]

>Diman111

К сожалению ссылка на не совсем бесплатную программу,

По указанной ссылке http://www.autocad.ru/cgi-bin/f1/board.cgi?t=868uY я писал Alan (2003-03-15 13:01:01)
о возможности БЕСПЛАТНОЙ высылки текста.
Выбор свай делается рамкой или секрамкой. Я не очень сильный прогаммист, поэтому текст посылал тому кто запрашивал, а не размещал.
Дурь не хотел показывать. Ну уж ладно, размещаю

Код:

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

;*******************************************************************************
;*     Программа : ПАРКС
;*    - Функция замены атрибута
; Функция  для изменения номеров сваи
;*         / AutoCAD/  язык AutoLISP      Назаров А.А. 11.02.95-2002    *
;*******************************************************************************
 
 
 

 
(defun C:Chan_Numb (/ i	  j	  pbx	  jp	  sa1	  sa2
		  aa2	  sa3	  sa4	  sort	  att	  seqend
		  att_value	  value_new	  value
		 )
  ( grtext -1 "(C) А.Назаров 2000г. ")
   ( prompt "\n Укажите сваи для изменения номеров " )
           
             (setq i 0
		   jp 1
		   pbx ( getvar "pickbox" )

;;;;;;Составления списка на изменение
		   sa1
		    (ssget   )
;;;	можно  так	   
;;;		    (ssget       '((0 . "INSERT")))
	     )
  ( setvar "pickbox" 3)
(while (/= nil (ssname sa1 i))
      (setq aa3	(entget (ssname sa1 i))
      )
;;; Удаление лишних примитивов из набора
      (if (/= "INSERT" (cdr (assoc 0 aa3)))

	(progn
	  (ssdel (cdr (assoc -1 aa3)) sa1)
	)
	(progn
;;;		новый список примитивов
	  (setq sa2 (cons aa3 sa2))
	  (setq i (1+ i))
	)
      )
    )
    

  
      (setq i	0
	    aa2	(length sa2)
      )
	(repeat	aa2
	  (setq	aa3 (nth i sa2)
	  )

;;; Удаление лишних примитивов из набора
;;;	   Блоков много, но у меня имена блоков сваи начинаются с этих символов: s или c
;;;	   
	  (if (and (/= "c" (strcase (substr (cdr (assoc 2 aa3)) 1 1) T))
;;;		   (/= "C" (substr (cdr (assoc 2 aa3)) 1 1))
		   (/= "s" (strcase (substr (cdr (assoc 2 aa3)) 1 1) T))
;;;		   (/= "S" (substr (cdr (assoc 2 aa3)) 1 1))
	      )
	    (progn
	    )
	    (progn
;;;		новый список примитивов
	      (setq sa4 (cons aa3 sa4))

	    )
	  )
	  (setq i (1+ i))
	)				; конец while по ТИпаМ примитивов и СЛОЯМ
   (setq aa2  (length sa4)
	 i    0
	 j    (getint
		(strcat "\Введите начальный номер сваи <" (itoa jp) ">:")
	      )
	 j    (if j
		j
		jp
	      )
	 jp   j
	 sort (getstring
		"\Введите направление сортировки по оси Х и У <++>:"
	      )
	 sort (if (= "" sort)
		"++"
		sort
	      )
   )
(if (> aa2 1)
	(cond

;;;сортировка по возрастанию Х
	  ((= sort "++")
	   (setq sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (< (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
			 )
		       )
		     )
		 sa4
		     (vl-sort
		       sa4
		       (function (lambda (e1 e2)
				   (< (caddr (assoc 10 e1)) (caddr (assoc 10 e2)))
				 )
		       )
		     )
	   )
	  )
	  ((= sort "-+")
	   (setq sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (> (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
			 )
		       )
		     )
		 sa4
		     (vl-sort
		       sa4
		       (function (lambda (e1 e2)
				   (< (caddr (assoc 10 e1)) (caddr (assoc 10 e2)))
				 )
		       )
		     )
	   )
	  )
	  ((= sort "+-")
	   (setq sa4
		     (vl-sort
		       sa4
		       (function (lambda (e1 e2)
				   (> (caddr (assoc 10 e1)) (caddr (assoc 10 e2)))
				 )
		       )
		     )
		 sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (< (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
			 )
		       )
		     )
	   )
	  )
	  ((= sort "--")
	   (setq sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (> (cadr (assoc 10 e1)) (cadr (assoc 10 e2)))
			 )
		       )
		     )

		 sa4 (vl-sort
		       sa4
		       (function
			 (lambda (e1 e2)
			   (> (caddr (assoc 10 e1)) (caddr (assoc 10 e2)))
			 )
		       )
		     )
	   )
	  )
	);;; cond

  )
(if (> aa2 0)
(progn
              (setq i 0)
 (repeat aa2
    (setq aa3 (cdr (car (nth i sa4))))

     (setq att (entnext aa3))
      (setq seqend (cdr (assoc 0 (entget att))))
      (while (not (eq seqend "SEQEND"))
	(setq att_value	(cdr (assoc 1 (entget att)))
	      value_new	(itoa j)
	      value	(subst (cons 1 value_new)
			       (assoc 1 (entget att))
			       (entget att)
			)
	)
	(entmod value)
	(entupd att)
	(setq att (entnext att))
	(setq seqend (cdr (assoc 0 (entget att))))
      )					; end while
    (setq j (1+ j))
    (setq i (1+ i))
)
  )
)



(prompt (strcat "\n Заменены номера у "  (itoa i) " свай"))

	(redraw)
  ( setvar "pickbox" pbx)
 (princ)
 
)

[Diman111]

Уважаемый Alan - при использовании вашего лиспа возникли затруднения - а именно - не меняется нумерация к сожалению.

Command: Chan_Numb

Укажите сваи для изменения номеров
Select objects: Specify opposite corner: 9 found

Select objects:
Введите начальный номер сваи <1>:
Введите направление сортировки по оси Х и У <++>:

Заменены номера у 0 свай
Command:
я и имя блока поменял на S1 (у вас в коде вроде бы фильтрются блоки по имени)- результат тот же

[Alan]

Шлите файл

[Diman111]

Сообщение от Alan Шлите файл

Выслал

[VVA]

Попробуй следующую модификацию программы Fatty

Код:

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

(defun C:SN (/ att ent num ss SPS what )
(setvar "attreq" 1) 
(initget 6) 
(setq num (getint "\n\tНачальный номер : "))
(initget "G V")
(setq what (getkword "\nСортировать [горизонтально(G)/вертикально(V)] <горизонтально>: "))
(if (null what)(setq what "G"))  
(setq ss (ssget (list (cons 0 "INSERT") 
         (cons 2 "СВАЯ С1") 
         (cons 66 1)))) 
   (if ss 
     (progn
          (repeat (sslength ss)
            (setq ent (ssname ss 0))
	    (setq en (entget ent))
	    (setq SPS (append SPS (list (list (cdr(assoc 10 en)) ent))))
            (ssdel ent ss) 
	    )
          (if (= what "G")
	    (setq SPS (vl-sort SPS (function (lambda (e1 e2) (< (caar e1) (caar e2))))))
	    (setq SPS (vl-sort SPS (function (lambda (e1 e2) (< (cadar e1) (cadar e2))))))
	    )
          (setq ss nil)
          (foreach ss SPS
	    (setq ent (cadr ss))
	    (setq en (entget ent)) 
	    (setq sub1 (entnext ent)) 
	    (setq suben (entget sub1)) 
	    (while (/= (cdr (assoc 0 suben)) "SEQEND")
	      (setq ctag (cdr (assoc 2 suben))) 
	      (if (= ctag "НОМЕР")
		(progn
		  (entmod (subst (cons 1 (itoa num)) (assoc 1 suben) suben))
		  (entupd ent)
		  (setq num (1+ num))
		  )
		)
	      (setq sub1 (entnext sub1)) 
	      (setq suben (entget sub1))
	      )
	    )
       )
     )
     (setvar "attreq" 0) 
     (princ) 
  )
(prompt "\nВ командной строке набери SN \n") 
(princ)

[Alan]

>Diman111
19-35 Файл не получил. Попробуйте направить на alnaz2004(A)mail.ru

[fixo]

Я смотрю тут уже сделали тебе добротную прогу, тем не менее,
раз уж сделал, тоже продемонстрирую
(без проверок на слои и т.д.)
А вообще мне кажется, это бесполезные добавления, свайное поле не всегда такое упорядоченное (я имею в виду сложный контур плана) ну как говорится, хозяин - барин

Код:

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

(defun C:SN (/ adoc att_list axss
	     blk_list num opt sort_list)
  
  (vl-load-com)
  (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
  )
  (if (and
	(= (getvar "tilemode") 0)
	(= (getvar "cvport") 1)
      )
    (setq acsp (vla-get-paperspace adoc))
    (setq acsp (vla-get-modelspace adoc))
  )  
(if (ssget (list (cons 0 "INSERT") 
         (cons 2 "СВАЯ С1") 
         (cons 66 1)))
(progn
(setvar "attreq" 1)
(vla-endundomark adoc)
(vla-startundomark adoc)
(initget 4) 
(setq num (getint "\n\t >> Начальный номер : ")) 
    (setq axss (vla-get-activeselectionset adoc))
    (vlax-for a axss
      (setq blk_list (cons a blk_list)))
    
(initget "X Y") 
(setq opt (getkword "\n\t >> Сортировать ряд по [X]-оси или [Y]-оси < X > : ")) 
(if (not opt)(setq opt "X"))
       (cond ((= opt "X") 
       (setq sort_list  (vl-sort blk_list
		(function (lambda (e1 e2)
			    (< (car (vlax-get e1 'Insertionpoint))
				(car (vlax-get e2 'Insertionpoint))))))))
	     ((= opt "Y")
       (setq sort_list  (vl-sort blk_list
		(function (lambda (e1 e2)
			    (< (cadr (vlax-get e1 'Insertionpoint))
				(cadr (vlax-get e2 'Insertionpoint)))))))) 
       (T (progn (princ "\nНеверная опция сортировки\n")
	    (exit)
	    (princ))))

(foreach blk_obj sort_list
(if (and (vlax-property-available-p blk_obj 'Hasattributes)
	 (vlax-read-enabled-p blk_obj)
	 (vlax-write-enabled-p blk_obj))
	   (progn
  (setq att_list (vlax-invoke blk_obj 'Getattributes))
  (foreach at att_list
    (if (eq (vla-get-tagstring at) "НОМЕР")
      (progn
	(vla-put-textstring at (itoa num))
	(vla-update at)
	(vla-update blk_obj))))))
  (setq num (1+ num)))
(vla-clear axss)
(vla-delete axss)
(vlax-release-object axss)))
(vla-regen adoc acactiveviewport)
(vla-endundomark adoc)  
(princ)
)
(prompt "\nВ командной строке набери SN \n") 
(princ)

~'J'~

[asys]

А мне больше нравится Sheet Set с Fieldсами

[Diman111]

Сообщение от Fatty Я смотрю тут уже сделали тебе добротную прогу, тем не менее, раз уж сделал, тоже продемонстрирую (без проверок на слои и т.д.) А вообще мне кажется, это бесполезные добавления, свайное поле не всегда такое упорядоченное (я имею в виду сложный контур плана) ну как говорится, хозяин - барин ~'J'~

Спасибо - прога самое оно (еще бы зациклить что бы каждый раз номера не вводить) .
НАсчет нужности - представь квадратное поле с 3 тыс свай и их надо пронумеровать а в дальнейшем возможно и не раз менять количество а значит и нумерацию свай.
вот и смысл. а насчет всегда или нет - так универсального ничего нет
и всеже - СПАСИБО БОЛЬШОЕ.

И СПАСИБО ВСЕМ КТО ОТКЛИКНУЛСЯ.

[Diman111]

Сообщение от Asys А мне больше нравится Sheet Set с Fieldсами

Прости за незнание - С ЧЕМ??? - может небольшой ликбез а ...

[Лентяй]

Diman111: ...а в дальнейшем возможно и не раз менять количество а значит и нумерацию свай.

Тады держи прогу для перенумеровки. Выкладвал надысь на другой теме, видать потому и проскользнула мимо тебя. Работает с форматами основных и дополнительных номеров осей, т.е. "1" и "1.1"

Код:

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

(defun *error* (msg)
  (if (= msg "Function cancelled") (princ msg)(princ));if
  (setvar "CMDECHO" cmd) (setvar "PICKAUTO" pca)   
);*error*
;
(defun C:KAN ( / ass cmd pca dn n at ast val kw)
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        cmd (getvar "CMDECHO") pca (getvar "PICKAUTO")
        ass (vla-get-ActiveSelectionSet adoc) n 0);setq
  (setvar "CMDECHO" 0)
  (initget "Number Renumber")
  (setq kw (getkword "\n[Number/Renumber]? <N>"))
  (if (null kw) (setq kw "Number"))
  (if (= kw "Number") (setvar "PICKAUTO" 0))
  (setq dn (getint "\nInput Start or Offset Number: <1>"))
  (if (null dn) (setq dn 1))
  (prompt (strcat "\nSelect Blocks for " kw "ing: "))
  (if (/= (vla-get-count ass) 0) (vla-clear ass)) 
  (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")))
  (vlax-for sb ass
    (setq at (car (vlax-invoke sb 'Getattributes)) 
          ast (vla-get-TextString at) val ast
          pt (vl-string-search "." val));setq
    (if (null pt) (while (wcmatch val "*@*") (setq val (substr val 2)))
      (setq val (substr val (+ 2 pt))));if
    (vla-put-TextString at (strcat (vl-string-right-trim val ast)
        (if (= kw "Number") (itoa (+ n dn)) (itoa (+ (atoi val) dn)))));vla-put
    (setq n (1+ n)));vlax-for
 (setvar "CMDECHO" cmd)
 (setvar "PICKAUTO" pca)
);end

[Alan]

>Diman111
Прошёлся своей программкой по Вашему чертежу, в верхней части (блок начинается с латинской буквы с) всё работает.
Для того чтобы работала нижняя часть (блок называется "Свая С1" с русской буквы с) добавьте строку в анализ.

Код:

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

;;; Удаление лишних примитивов из набора
;;;	   Блоков много, но у меня имена блоков сваи начинаются с этих символов: s или c
;;;	   
	  (if (and (/= "c" (strcase (substr (cdr (assoc 2 aa3)) 1 1) t))	; это c - латинская буква 
;;; для Вашего нижнего плана ; это c - русская  буква
		   (/= "с" (strcase (substr (cdr (assoc 2 aa3)) 1 1) t))			   
             (/= "s" (strcase (substr (cdr (assoc 2 aa3)) 1 1) t))
	      ) ;_ конец and
	    (progn 
;;; тут был кусок, не обращайте внимание
	    )
	    (progn
;;;		новый список примитивов
	      (setq sa4 (cons aa3 sa4))

	    )
	  )
	  (setq i (1+ i))
	)				; конец while по ТИпаМ примитивов и СЛОЯМ

[Diman111]

Я прошу прощения, но так и остался без внимания мелкий нюанс - нумарация должна идти змейкой - т.е. сначала слева направо потом справа налево - так едет обычно сваебой и так нумеруют сваи.
прога господина Fatty к сожалению этот нюанс не учитывает, а следовательно - половину свай - нумеровать руками. Если не сложно дополните пожалуйста программу учетом направления выделения или вводом направления оси - по оси или против оси..
Лентяй - ваша программа к сожалению не позволяет выделять рамкой - а так - хороша .
Спасибо всем еще раз ).

[Лентяй]

>Alan А моя прога буквы игнорирует, что русские, что латинские, что какие

[Diman111]

Сообщение от Alan >Diman111 Прошёлся своей программкой по Вашему чертежу, в верхней части (блок начинается с латинской буквы с) всё работает. Для того чтобы работала нижняя часть (блок называется "Свая С1" с русской буквы с) добавьте строку в анализ.

Спасибо - это то что нужно - учитывает и направление оси - против или по оси и саму ось - Х или Y.
)))

[Лентяй]

Diman111: ваша программа к сожалению не позволяет выделять рамкой

Тут мы вас, господин хороший, по-товарищески поправим. Программа писалась дл определения исходной нумерации вручную. НО! Единожды установленные (например, программой Fatty) номера для перенумеровки могут выбираться рамкой или секрамкой.

[Alan]

>Лентяй Вт Дек 27, 2005 09:39
Программа выдрана из работающего комплекса вычерчивания свайных кустов, полей и т.п. Без рекламы...
У меня на чертежах блоков много, не только свай, и в принципе имя свайного блока д.б. ЯТД своеобразным.

[fixo]

Если для цикла и нумерации как положено (змейкой)
попробуй следующий вариант
(выбирай рамкой ряды по направлению нумерации по любой оси)

Код:

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

; переменную *last_number* оставить глобальной

(defun C:SN (/	      *error*  adoc	att_list axss	  blk_list
	     fpt      num      oaq	oat	 oqa	  osm
	     sort_list	       spt	test_list
	    )

  (vl-load-com)

  (defun *error* (error)
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error)))
    )
    (setvar "osmode" osm)
    (setvar "attdia" oat)
    (setvar "attreq" oaq)
    (setvar "qaflags" oqa)
    (setvar "cmdecho" 1)
    (vla-endundomark adoc)
    (princ)
  )
  (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
  )

  (vla-endundomark adoc)
  (vla-startundomark adoc)
  (setvar "cmdecho" 0)
  (setq oat (getvar "attdia"))
  (setq osm (getvar "osmode"))
  (setq oaq (getvar "attreq"))
  (setq oqa (getvar "qaflags"))

  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется)
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения   
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку
  (setvar "osmode" 0)

  (while (setq fpt (getpoint "\nПервый угол рамки выбора >> \n"))
    (setq spt (getcorner fpt "\nПервый угол рамки выбора >> \n"))
    (if	(ssget "_W"
	       fpt
	       spt

	       (list (cons 0 "INSERT")
		     (cons 2 "СВАЯ С1")
		     (cons 66 1)
	       )
	)
      (progn

	(initget 4)
	(setq
	  num (getint
		"\n\t >> Начальный номер [Enter для продолжения] : "
	      )
	)
	(if (not num)
	  (progn
	    (if	*last_number*
	      (setq num *last_number*)
	      (setq num
		     (getint
		       "\n\t >> Первый раз номер задается обязательно : "
		     )
	      )
	    )
	  )
	)

	(setq axss (vla-get-activeselectionset adoc))
	(vlax-for a axss
	  (setq blk_list (cons a blk_list))
	)
	(setq
	  test_list (mapcar (function (lambda (x)
					(vlax-get x 'Insertionpoint)
				      )
			    )
			    blk_list
		    )
	)


	(setq sort_list
	       (vl-sort
		 blk_list
		 (function
		   (lambda (e1 e2)
		     (if
		       (vl-every
			 (function
			   (lambda (x)
			     (equal (cadr x) (cadar test_list) 0.1)
			   )
			 )
			 test_list
		       )
			(<
			  (abs (- (car fpt)
				  (car (vlax-get e1 'Insertionpoint))
			       )
			  )
			  (abs (- (car fpt)
				  (car (vlax-get e2 'Insertionpoint))
			       )
			  )
			)
			(< (abs
			     (-	(cadr fpt)
				(cadr (vlax-get e1 'Insertionpoint))
			     )
			   )
			   (abs
			     (-	(cadr fpt)
				(cadr (vlax-get e2 'Insertionpoint))
			     )
			   )
			)
		     )
		   )
		 )
	       )
	)

	(foreach blk_obj sort_list
	  (if (and (vlax-property-available-p blk_obj 'Hasattributes)
		   (vlax-read-enabled-p blk_obj)
		   (vlax-write-enabled-p blk_obj)
	      )
	    (progn
	      (setq att_list (vlax-invoke blk_obj 'Getattributes))
	      (foreach at att_list
		(if (eq (vla-get-tagstring at) "НОМЕР")
		  (progn
		    (vla-put-textstring at (itoa num))
		    (vla-update at)
		    (vla-update blk_obj)
		  )
		)
	      )
	    )
	  )
	  (setq num (1+ num))
	)
	(vla-clear axss)
	(vla-delete axss)
	(vlax-release-object axss)
	(setq axss nil)
	(setq blk_list nil)
      )
    )
    (setq *last_number* num)
  )
  (vla-regen adoc acactiveviewport)
  (*error* nil)
  (princ)
)
(prompt "\nВ командной строке набери SN \n") 
(princ)

~'J'~

[Diman111]

Большое пребольшое спасибо
Все как и хотел ))

Пологаю вы, Уважаемый Fatty, помогли не только мне

[VVA]

Пока достучался до сайта уже все написали
Еще одна модификация программы Fatty в отличие от последней
нумерует змейкой по полю.
Т.к. последняя хороша, то присваиваю ей следующий порядковый номер

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

Код:

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

(defun C:SN1 (/ adoc att_list axss 
        blk_list num opt sort_list fuzz sort_blk_list blk_obj pt buf buf1 count modm what) 
  (initget 4)
  (setq modm (getvar "MODEMACRO"))
  (setq fuzz (getreal "\nДопуск для сортировки <1>: "))
  (if (null fuzz)(setq fuzz 1))                          ;_Допуск для сортировки
  (vl-load-com) 
  (setq   adoc (vla-get-activedocument 
          (vlax-get-acad-object) 
        ) 
  ) 
  (if (and 
   (= (getvar "tilemode") 0) 
   (= (getvar "cvport") 1) 
      ) 
    (setq acsp (vla-get-paperspace adoc)) 
    (setq acsp (vla-get-modelspace adoc)) 
  )  
(if (ssget (list (cons 0 "INSERT") 
         (cons 2 "СВАЯ С1") 
         (cons 66 1))) 
(progn 
(setvar "attreq" 1) 
(vla-endundomark adoc) 
(vla-startundomark adoc) 
(initget 4) 
(setq num (getint "\n\t >> Начальный номер <1> : "))
(if (null num)(setq num 1))
    (setq axss (vla-get-activeselectionset adoc)) 
    (vlax-for a axss 
      (setq blk_list (cons a blk_list))) 
    
(initget "X Y") 
(setq opt (getkword "\n\t >> Сортировать ряд по [X оси/Y оси] < X > : ")) 
(if (not opt)(setq opt "X"))
(setq count 1)
(while (setq blk_obj (car blk_list))

  (setq buf nil)
  (setq buf1 nil)
  (setq pt (vlax-get blk_obj 'Insertionpoint))
  (setvar "MODEMACRO" (strcat "Сортировка-" (itoa count)))
  (if (= opt "X")(setq WHAT cadr)(setq WHAT car))
  (setq buf (vl-remove-if-not ;_Оставляем все что совпадает
	      (function
		(lambda (e1)
		  (equal (WHAT pt)(WHAT (vlax-get e1 'Insertionpoint)) fuzz)))
	      blk_list
	      ))
  (setq buf1 (vl-remove-if ;_Оставляем все что не совпадает
	       (function
		 (lambda (e1)
		   (equal (WHAT pt)(WHAT (vlax-get e1 'Insertionpoint)) fuzz)))
	      blk_list
	      ))
    (setq count (1+ count))
    (setq blk_list buf1)
    (setq sort_blk_list (append sort_blk_list (list buf)))
  );_while
  (setvar "MODEMACRO" modm)
(setq sort_blk_list
 (vl-sort sort_blk_list
    (function
      (lambda (e1 e2)
	(< (WHAT (vlax-get (car e1) 'Insertionpoint)) 
        (WHAT (vlax-get (car e2) 'Insertionpoint)))))))

;_Если стоит EXPRESS то внизу будет бегунок  
(if acet-ui-progress-init
 (acet-ui-progress-init "Нумерация свай" (length sort_blk_list))
 (setvar "MODEMACRO" "")
)
(setq count 1)
  (setq blk_list nil)
  (foreach blk_list sort_blk_list
       (if acet-ui-progress-safe
        (acet-ui-progress-safe count)
        (setvar "MODEMACRO" (strcat "Ряд свай-" (itoa count)))
       )
    
       (cond ((= opt "X") 
       (setq sort_list  (vl-sort blk_list 
      (function (lambda (e1 e2) 
             (< (car (vlax-get e1 'Insertionpoint)) 
            (car (vlax-get e2 'Insertionpoint)))))))) 
        ((= opt "Y") 
       (setq sort_list  (vl-sort blk_list 
      (function (lambda (e1 e2) 
             (< (cadr (vlax-get e1 'Insertionpoint)) 
            (cadr (vlax-get e2 'Insertionpoint)))))))) 
       (T (progn (princ "\nНеверная опция сортировки\n") 
       (exit) 
       (princ)))) 
       (if (zerop (logand count 1)) ;_Четное переворачиваем список
	 (setq sort_list (reverse sort_list))
	 )
(foreach blk_obj sort_list 
(if (and (vlax-property-available-p blk_obj 'Hasattributes) 
    (vlax-read-enabled-p blk_obj) 
    (vlax-write-enabled-p blk_obj)) 
      (progn 
  (setq att_list (vlax-invoke blk_obj 'Getattributes)) 
  (foreach at att_list 
    (if (eq (vla-get-tagstring at) "НОМЕР") 
      (progn 
   (vla-put-textstring at (itoa num)) 
   (vla-update at) 
   (vla-update blk_obj)))))) 
  (setq num (1+ num)))
  (setq count (1+ count))  
);_foreach blk_list
 (if acet-ui-progress-done
    (acet-ui-progress-done)
    (setvar "MODEMACRO" "")
 )
(vla-clear axss) 
(vla-delete axss) 
(vlax-release-object axss))) 
(vla-regen adoc acactiveviewport) 
(vla-endundomark adoc)
(setvar "MODEMACRO" modm)  
(princ) 
) 
(prompt "\nВ командной строке набери SN1 \n") 
(princ)

[fixo]

Сообщение от Diman111 Большое пребольшое спасибо Все как и хотел )) Пологаю вы, Уважаемый Fatty, помогли не только мне

Буду рад если и работать будет как надо,
не всегда есть время, чтобы обкатать достаточно...

[Diman111]

Уважаемый VVA - ваша модификация очень хороша но есть один ньюанс - она нумерует только снизу вверх - а если мне хочется сверху вних змейку строить или еще как - такого диалога не предусмотрена и направление выделения программка не контролирует к сожалению.
и не совсем понятен смысл запроса о допуске - что за допуск ?

[Лентяй]

>Fatty
Признаться, вы меня удивили - такое наваяли, даже придраться не к чему. Единственное, что сделал - добавил по слезной просьбе Diman111 опцию "Вперед/Назад", уж очень он просил. Ну, и конечно, было бы просто преступно не использовать фокус VVA с переназначением оператора.

Код:

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

(defun C:SN-A (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm)
  (vl-load-com)
  (defun *error* (error) 
    (cond ((not error))
          ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
          (1 (princ (strcat "\nERROR: " error))))
    (setvar "osmode" osm)  (setvar "attdia" oat) 
    (setvar "attreq" oaq) (setvar "qaflags" oqa) 
    (setvar "cmdecho" 1) (vla-endundomark adoc) 
    (princ));defun
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark adoc) 
  (vla-startundomark adoc) 
  (setvar "cmdecho" 0) 
  (setq oat (getvar "attdia") osm (getvar "osmode")
        oaq (getvar "attreq") oqa (getvar "qaflags")) 
  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) 
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения    
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку  
  (setvar "osmode" 0) 
  (while (setq fpt (getpoint "\nПервый угол рамки выбора >> \n")
               spt (getcorner fpt "\nВторой угол рамки выбора >> \n"))
    (if (ssget "_W" fpt spt (list (cons 0 "INSERT") (cons 2 "СВАЯ С1") (cons 66 1)))
      (progn (initget 4)
        (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : "))
        (if (not num) (setq num (if *last_number* *last_number*)
                            (getint "\n\t >> Первый раз номер задается обязательно  : ")))
        (setq axss (vla-get-activeselectionset adoc))
        (vlax-for a axss (setq blk_list (cons a blk_list)))
        (initget "Вперед Назад")
        (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>"))
        (if (null dir) (setq dir "Вперед"))
        (if (= dir "Вперед") (setq cm <) (setq cm >))  
        (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list)
              sort_list (vl-sort blk_list '(lambda (e1 e2)
                          (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list)
                            (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint))))
                               (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint)))))
                            (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint))))
                               (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq
        (foreach blk_obj sort_list
          (if (and (vlax-property-available-p blk_obj 'Hasattributes)
                   (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj))
            (progn (setq att_list (vlax-invoke blk_obj 'Getattributes))
              (foreach at att_list
                (if (eq (vla-get-tagstring at) "ÍÎÌÅÐ")
                  (progn (vla-put-textstring at (itoa num))
                    (vla-update at) (vla-update blk_obj))))));if
          (setq num (1+ num)));foreach
        (vla-clear axss) (vla-delete axss)
        (vlax-release-object axss) (setq axss nil)
        (setq blk_list nil)));if
    (setq *last_number* num));while
  (vla-regen adoc acactiveviewport) 
  (*error* nil) 
  (princ) 
);end
(prompt "\nВ командной строке набери SN-A \n") 
(princ)

Должно работать (я так думаю ).

[Diman111]

Лентяй - пишет

Command: _appload 1.lsp successfully loaded.


Command: ; error: syntax error

Command:

[Лентяй]

Diman111: Command: ; error: syntax error

Ну и сволочь она после этого ! Ну, ничего, сегодня работы немного - поковыряюсь

[Лентяй]

Исправленному верить. Лентяй

Код:

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

(defun C:SN-A (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm) 
  (vl-load-com) 
  (defun *error* (error) 
    (cond ((not error)) 
          ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) 
          (1 (princ (strcat "\nERROR: " error)))) 
    (setvar "osmode" osm)  (setvar "attdia" oat) 
    (setvar "attreq" oaq) (setvar "qaflags" oqa) 
    (setvar "cmdecho" 1) (vla-endundomark adoc) 
    (princ));defun 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-endundomark adoc) 
  (vla-startundomark adoc) 
  (setvar "cmdecho" 0) 
  (setq oat (getvar "attdia") osm (getvar "osmode") 
        oaq (getvar "attreq") oqa (getvar "qaflags")) 
  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) 
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения    
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку  
  (setvar "osmode" 0) 
  (while (setq fpt (getpoint "\nПервый угол рамки выбора >> \n") 
               spt (getcorner fpt "\nВторой угол рамки выбора >> \n")) 
    (if (ssget "_W" fpt spt (list (cons 0 "INSERT") (cons 2 "СВАЯ С1") (cons 66 1))) 
      (progn (initget 4) 
        (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) 
        (if (not num) (setq num (if *last_number* *last_number* 
                            (getint "\n\t >> Первый раз номер задается обязательно  : "))))
        (setq axss (vla-get-activeselectionset adoc)) 
        (vlax-for a axss (setq blk_list (cons a blk_list))) 
        (initget "Вперед Назад") 
        (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) 
        (if (null dir) (setq dir "Вперед")) 
        (if (= dir "Вперед") (setq cm <) (setq cm >))  
        (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) 
              sort_list (vl-sort blk_list '(lambda (e1 e2) 
                          (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) 
                            (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) 
                            (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq 
        (foreach blk_obj sort_list 
          (if (and (vlax-property-available-p blk_obj 'Hasattributes) 
                   (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj)) 
            (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) 
              (foreach at att_list 
                (if (eq (vla-get-tagstring at) "НОМЕР") 
                  (progn (vla-put-textstring at (itoa num)) 
                    (vla-update at) (vla-update blk_obj))))));if 
          (setq num (1+ num)));foreach 
        (vla-clear axss) (vla-delete axss) 
        (vlax-release-object axss) (setq axss nil) 
        (setq blk_list nil)));if 
    (setq *last_number* num));while 
  (vla-regen adoc acactiveviewport) 
  (*error* nil) 
  (princ) 
);end 
(prompt "\nВ командной строке набери SN-A \n") 
(princ)

[Diman111]

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

>> Начальный номер [Enter для продолжения] :

Направление [Вперед/Назад]: <Вперед>

Первый угол рамки выбора >>

Второй угол рамки выбора >>

>> Начальный номер [Enter для продолжения] :

Направление [Вперед/Назад]: <Вперед>

Первый угол рамки выбора >>

Второй угол рамки выбора >>

>> Начальный номер [Enter для продолжения] :

Направление [Вперед/Назад]: <Вперед>

Первый угол рамки выбора >>

Второй угол рамки выбора >>

>> Начальный номер [Enter для продолжения] :

Направление [Вперед/Назад]: <Вперед>

Первый угол рамки выбора >>

Второй угол рамки выбора >>

>> Начальный номер [Enter для продолжения] :

Направление [Вперед/Назад]: <Вперед>

Первый угол рамки выбора >>
и т.д.

[Лентяй]

Почему я не удивлен? Потому что товарищ автор-инициатор Fatty напихал в исходную прогу до хренища проверок и прерпроверок, чиста, как в КГБ. И если хоть одна из них не проходит, то ничего и не получается. Во время отладки я эти проверки, есс-но, отключал, а потом восстанавливал, потому что меня мама учила уважать чужой труд и ничего без нужды не портить. . Поскольку я не знаю, откуда уважаемый тов. Fatty набрался идей для этих проверок, то спрашиваю вас:
1. Называется ли ваш блок "СВАЯ С1"?
2. Имеет ли атрибут, обозначающий номер сваи тэг (бирку?) "НОМЕР"?
Если вы хотя бы на один из этих вопросов ответите "НЕТ", то программа и не будет работать (спасибо, Fatty). Если же на оба вопроса вы ответите "ДА", тогда... тогда будем думать, потому как у меня все работало. :twisted: Да, и плз - ответьте в течение получаса, а то я уйду баиньки, потому как, когда у вас - утро, у нас - вовсе даже наоборот. :?

[Лентяй]

Ну, вот Diman111, пока вы собирались, я все и выяснил. :idea: Доперепроверялся наш Fatty, аж мз цикла не вылезти. Короче, никому эти while'ы не нужны, и без них все прекрасно работает, а вот с ними - виснет. :twisted: Убрать эти while'ы на хрен :!:

Код:

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

(defun C:SN-A (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm) 
  (vl-load-com) 
  (defun *error* (error) 
    (cond ((not error)) 
          ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) 
          (1 (princ (strcat "\nERROR: " error)))) 
    (setvar "osmode" osm)  (setvar "attdia" oat) 
    (setvar "attreq" oaq) (setvar "qaflags" oqa) 
    (setvar "cmdecho" 1) (vla-endundomark adoc) 
    (princ));defun 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-endundomark adoc) 
  (vla-startundomark adoc) 
  (setvar "cmdecho" 0) 
  (setq oat (getvar "attdia") osm (getvar "osmode") 
        oaq (getvar "attreq") oqa (getvar "qaflags")) 
  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) 
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения    
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку  
  (setvar "osmode" 0) 
  (setq fpt (getpoint "\nПервый угол рамки выбора >> \n") 
               spt (getcorner fpt "\nВторой угол рамки выбора >> \n")) 
    (if (ssget "_W" fpt spt (list (cons 0 "INSERT") (cons 2 "СВАЯ С1") (cons 66 1))) 
      (progn (initget 4) 
        (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) 
        (if (not num) (setq num (if *last_number* *last_number* 
                            (getint "\n\t >> Первый раз номер задается обязательно  : ")))) 
        (setq axss (vla-get-activeselectionset adoc)) 
        (vlax-for a axss (setq blk_list (cons a blk_list))) 
        (initget "Вперед Назад") 
        (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) 
        (if (null dir) (setq dir "Вперед")) 
        (if (= dir "Вперед") (setq cm <) (setq cm >))  
        (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) 
              sort_list (vl-sort blk_list '(lambda (e1 e2) 
                          (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) 
                            (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) 
                            (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq 
        (foreach blk_obj sort_list 
          (if (and (vlax-property-available-p blk_obj 'Hasattributes) 
                   (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj)) 
            (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) 
              (foreach at att_list 
                (if (eq (vla-get-tagstring at) "НОМЕР") 
                  (progn (vla-put-textstring at (itoa num)) 
                    (vla-update at) (vla-update blk_obj))))));if 
          (setq num (1+ num)));foreach 
        (vla-clear axss) (vla-delete axss) 
        (vlax-release-object axss) (setq axss nil) 
        (setq blk_list nil)));if 
  (setq *last_number* num) 
  (vla-regen adoc acactiveviewport) 
  (*error* nil) 
  (princ) 
);end 
(prompt "\nВ командной строке набери SN-A \n") 
(princ)

Все, ушел спать!

[VVA]

К вопросу отсюда
Модификация команды из #37. В переменные blkname и attname вынесены названия блока и атрибута для хранения номера
Вписать свое имя блока и имя тага атрибута там, где выделено красным
ВАЖНО!!!
Порядок указания углов рамки выбора задает направление нумерации (снизу-вверх или сверху-вниз)

Код:

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

;;; Модификация кода Лентяй, опубликованного
;;; http://dwg.ru/f/showpost.php?p=50584&postcount=37
;;; В переменные blkname и attname вынесены названия блока и атрибута для хранения номера
;;; Полезные ссылки:
;;; Нумерация, перенумерация
;;; http://www.caduser.ru/cgi-bin/f1/board.cgi?t=33416cQ&page=1
;;; Как правильно загрузить этот лисп
;;; http://dwg.ru/art/8
(defun C:SN (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm blkname attname)
  (setq blkname "СВАЯ"  ;_ Имя блока сваи
	attname "NUM"   ;_ Имя аттрибута
  )
  (vl-load-com) 
  (defun *error* (error) 
    (cond ((not error)) 
          ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) 
          (1 (princ (strcat "\nERROR: " error)))) 
    (setvar "osmode" osm)  (setvar "attdia" oat) 
    (setvar "attreq" oaq) (setvar "qaflags" oqa) 
    (setvar "cmdecho" 1) (vla-endundomark adoc) 
    (princ));defun 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-endundomark adoc) 
  (vla-startundomark adoc) 
  (setvar "cmdecho" 0) 
  (setq oat (getvar "attdia") osm (getvar "osmode") 
        oaq (getvar "attreq") oqa (getvar "qaflags")) 
  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) 
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения    
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку  
  (setvar "osmode" 0) 
  (setq fpt (getpoint "\nПервый угол рамки выбора >> \n") 
               spt (getcorner fpt "\nВторой угол рамки выбора >> \n")) 
    (if (ssget "_W" fpt spt (list (cons 0 "INSERT") (cons 2 "СВАЯ") (cons 66 1))) 
      (progn (initget 4) 
        (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) 
        (if (not num) (setq num (if *last_number* *last_number* 
                            (getint "\n\t >> Первый раз номер задается обязательно  : ")))) 
        (setq axss (vla-get-activeselectionset adoc)) 
        (vlax-for a axss (setq blk_list (cons a blk_list))) 
        (initget "Вперед Назад") 
        (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) 
        (if (null dir) (setq dir "Вперед")) 
        (if (= dir "Вперед") (setq cm <) (setq cm >))  
        (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) 
              sort_list (vl-sort blk_list '(lambda (e1 e2) 
                          (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) 
                            (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) 
                            (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq 
        (foreach blk_obj sort_list 
          (if (and (vlax-property-available-p blk_obj 'Hasattributes) 
                   (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj)) 
            (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) 
              (foreach at att_list 
                (if (eq (strcase(vla-get-tagstring at))(strcase attname))
                  (progn (vla-put-textstring at (itoa num)) 
                    (vla-update at) (vla-update blk_obj))))));if 
          (setq num (1+ num)));foreach 
        (vla-clear axss) (vla-delete axss) 
        (vlax-release-object axss) (setq axss nil) 
        (setq blk_list nil)));if 
  (setq *last_number* num) 
  (vla-regen adoc acactiveviewport) 
  (*error* nil) 
  (princ) 
);end 
(prompt "\nВ командной строке набери SN \n") 
(princ)

[SLADE]

VVA выкладываю свой блок (свая) - динамический.
Лисп отлично срабатывает при начальном положении дин. параметров (считает), но как только я переняю какой-нибудь дин. параметр (потяну за ручку или перемещу арибут, так лисп игнарирует этот блок (невидит) и пропускает его. Надеюсь понятно "раслумачыу" ?

[VVA]

SLADE, С учетом динамических блоков

Код:

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

(defun C:SN (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm blkname attname e1)
;;; 17.11.2008 Добавлена обработка динамических блоков (эффективное имя)
;;; Модификация кода Лентяй, опубликованного
;;; http://forum.dwg.ru/showpost.php?p=50584&postcount=37
;;; В переменные blkname и attname вынесены названия блока и атрибута для хранения номера
;;; Полезные ссылки:
;;; Нумерация, перенумерация
;;; http://www.caduser.ru/cgi-bin/f1/boa...33416cQ&page=1
;;; Как правильно загрузить этот лисп
;;; http://dwg.ru/pub/9
  (setq blkname "СВАЯ"  ;_ Имя блока сваи
 attname "NUM"   ;_ Имя аттрибута
  )
  (vl-load-com) 
  (defun *error* (error) 
    (cond ((not error)) 
          ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) 
          (1 (princ (strcat "\nERROR: " error)))) 
    (setvar "osmode" osm)  (setvar "attdia" oat) 
    (setvar "attreq" oaq) (setvar "qaflags" oqa) 
    (setvar "cmdecho" 1) (vla-endundomark adoc) 
    (princ));defun 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-endundomark adoc) 
  (vla-startundomark adoc) 
  (setvar "cmdecho" 0) 
  (setq oat (getvar "attdia") osm (getvar "osmode") 
        oaq (getvar "attreq") oqa (getvar "qaflags")) 
  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) 
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения    
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку  
  (setvar "osmode" 0) 
  (setq fpt (getpoint "\nПервый угол рамки выбора >> \n") 
               spt (getcorner fpt "\nВторой угол рамки выбора >> \n"))
  
    (if  (setq axss (ssget "_W" fpt spt (list (cons 0 "INSERT")(cons 66 1))))
      (progn
 (setq num '-1)
 (repeat (sslength axss)
   (setq blk_list (cons (vlax-ename->vla-object(ssname axss (setq num (1+ num)))) blk_list))
   )
 (initget 4) 
        (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) 
        (if (not num) (setq num (if *last_number* *last_number* 
                            (getint "\n\t >> Первый раз номер задается обязательно  : "))))
        (initget "Вперед Назад") 
        (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) 
        (if (null dir) (setq dir "Вперед")) 
        (if (= dir "Вперед") (setq cm <) (setq cm >))  
        (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) 
              sort_list (vl-sort blk_list '(lambda (e1 e2) 
                          (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) 
                            (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) 
                            (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq 
        (foreach blk_obj sort_list 
          (if (and (vlax-property-available-p blk_obj 'Hasattributes) 
                   (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj)
     (= (strcase blkname)
        (strcase
   (cond
     ((and (vlax-property-available-p blk_obj 'isdynamicblock)
    (= (vla-get-isdynamicblock blk_obj) :vlax-true)
    ) ;_ end of and
      (vla-get-effectivename blk_obj)
      )
     (t (vla-get-name blk_obj))
     )
   )
        )
     )
            (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) 
              (foreach at att_list 
                (if (eq (strcase(vla-get-tagstring at))(strcase attname))
                  (progn (vla-put-textstring at (itoa num)) 
                    (vla-update at) (vla-update blk_obj))))));if 
          (setq num (1+ num)));foreach 
        (setq axss nil) 
        (setq blk_list nil)));if 
  (setq *last_number* num) 
  (vla-regen adoc acactiveviewport) 
  (*error* nil) 
  (princ) 
);end 
(prompt "\nВ командной строке набери SN \n") 
(princ)

[delmarioche]

думаю вот это то что тебе нужно!)
работаю уже года два ни разу не подводила

-VBARUN;ThisDrawing.Run_Ferrumattr;

по вопросам загрузки и пользованию програмы обращайтесь всегда рад буду помоч.....

[V1ktor1a]

Всем добрый день!
Я ваще мега чайник.
С липсами поняла
Но взяв код для нумератора от любого автора не получаю нужного.
Два дня уже бьюсь
не понимаю что куда вводить после тога как строчки команды меняются
Выходит, чтобы получить нормальное выполнение команды нужно самой научиться создавать программки...
Помогите, плиз)
Автокад электрикал.
нужно тоже чтоб например:
1.1 ... 1.5 и тд
или 1-1/1....1-1/5 и тд
но чтобы привязка последующих номеров была там где кликает мышка.
если есть такое то дайте ссылку и оч нужно что вписывать понять))
Заранее благодарна

[Олег (jr.)]

Сообщение от V1ktor1a Всем добрый день! Я ваще мега чайник. С липсами поняла Но взяв код для нумератора от любого автора не получаю нужного. Два дня уже бьюсь не понимаю что куда вводить после тога как строчки команды меняются Выходит, чтобы получить нормальное выполнение команды нужно самой научиться создавать программки... Помогите, плиз) Автокад электрикал. нужно тоже чтоб например: 1.1 ... 1.5 и тд или 1-1/1....1-1/5 и тд но чтобы привязка последующих номеров была там где кликает мышка. если есть такое то дайте ссылку и оч нужно что вписывать понять)) Заранее благодарна

Если нужно вставлять простой текст то попробуй:

Код:

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

 (defun	C:nom  (/ head inc inc_num ipt odz pt start tail)

   (setq odz (getvar "dimzin"))
   (setvar "dimzin" 3)
   
   (setq start (getstring "\nЗадайте начальное значение <1.0 или 1-1/1>: "))

   (setq inc (getstring
	       "\nЗадайте приращение <десятичные только через точку, напр. 0.1>: "))

   (cond ((vl-string-search "." inc 0)
	  (setq inc_num (atof inc))
	  (setq flag 1)
	  )
	 ((vl-string-search "/" inc 0)
	  (setq inc_num (atoi inc))
	  (setq flag 2))
	 (T
	  (setq inc_num (atoi inc))
	  (setq flag 2)
	  )
	 )
   
   (while (setq	ipt (getpoint
		      "\nУказать точку вставки текста <или Enter для завершения>: "))
     (entmake (list (cons 0 "TEXT")
		    (cons 10 ipt)
		    (cons 11 ipt)
		    (cons 1 start)
		    (cons 7 (getvar "TEXTSTYLE"))
		    (cons 40 (getvar "TEXTSIZE"))
		    (cons 72 4))
	      )

     (if (= 1 flag)
       (setq start (rtos (+ (atof start) inc_num) 2 1))
       (progn
	 (setq head (substr start 1 (1+ (vl-string-search "/" start 0))))
	 (setq tail (substr start (+ 2 (vl-string-search "/" start 0))))
	 (setq start (strcat head (itoa (+ inc_num (atoi tail))))))
       )
     )
   (setvar "dimzin" odz)
   (princ)
   )
 (princ "\n\t\t***\tПрограмма загружена, введите в командной строке: NOM\t***")
 (princ)

~'J'~

[dafara]

Подскажите пожалуйста, а можно при помощи нумератора нумеровать мультивыноски? Если да, то ссылочку пожалуйста скиньте на программу.

[VVA]

Нумератор для мультивыносок

[v_alex]

глубоко извиняюсь... прочел кучу тем по автоматической нумерации... но не нашел возможности нумеровать атрибуты буквами А, Б, В и так далее... в общем хочется блоки осей нумеровать... подскажите пожалуйста, может кто видел подобный лисп...

[Alan]

Сообщение от v_alex глубоко извиняюсь... прочел кучу тем по автоматической нумерации... но не нашел возможности нумеровать атрибуты буквами А, Б, В и так далее... в общем хочется блоки осей нумеровать... подскажите пожалуйста, может кто видел подобный лисп...

Вообще-то количество букв ограничено...
Но никто вам не мешает использовать список Букв

Код:

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

(setq MList  '(А Б В Г Д Е Ж И К Л М Н П Р С Т У Ф Х Ц Ч Ш Щ Э Ю Я))
;;;с последовательным выбором из списка
(setq marka (nth i Mlist))
;;; ,где i - счетчик цикла

[Alexeipost]

Периодически просматриваю сайт очень мною уважаемого Lee Mac и вот буквально только что наткнулся на программку от него, которая в режиме реального времени нумерует блоки. Прога очень интересна тем, что в продолжает нумерацию блоков при их вставке/копировании, а также перенумеровывает при удалении любого блока. Всем заинтересовавшимся смотреть на lee-mac.com

[tryba22]

Спасибо, VVA за код из поста #40, но было бы неплохо добавить в него еще суффиксы и префиксы

[Кулик Алексей aka kpblc]

tryba22, если мне не изменяет моя память, то: стоит заняться поиском, и нумераторов будет тьма-тьмущая. И с суффиксами, и с префиксами, и с бантиками, и с хвостиками...

[tryba22]

Это верно, их тьма, поиском пользоваться умею, перепробовал каждый, самый стабильный и удовлетворяющий моим условиям оказался именно этот, но без префиксов, недостатки других описывать не зачем, говорю как есть.

[VVA]

tryba22,
Добавил с другого нумератора. Не проверял, но должно работать. Перевод, если нужно, сделаешь сам.

Код:

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

(defun C:SN (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm blkname attname e1 oldPref oldSuf)
;;; Vladimir Azarko (VVA) for dwr.ru  
;;;http://forum.dwg.ru/showthread.php?t=5059&page=2
;;; 11.04.20112 Добавлен префикс суффикс
;;; 17.11.2008 Добавлена обработка динамических блоков (эффективное имя)
;;; Модификация кода Лентяй, опубликованного
;;; http://dwg.ru/f/showpost.php?p=50584&postcount=37
;;; В переменные blkname и attname вынесены названия блока и атрибута для хранения номера
;;; Полезные ссылки:
;;; Нумерация, перенумерация
;;; http://www.caduser.ru/cgi-bin/f1/boa...33416cQ&page=1
;;; Как правильно загрузить этот лисп
;;; http://dwg.ru/art/8
  (setq blkname "СВАЯ"  ;_ Имя блока сваи
 attname "NUM"   ;_ Имя аттрибута
  )
  (vl-load-com) 
  (defun *error* (error) 
    (cond ((not error)) 
          ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) 
          (1 (princ (strcat "\nERROR: " error)))) 
    (setvar "osmode" osm)  (setvar "attdia" oat) 
    (setvar "attreq" oaq) (setvar "qaflags" oqa) 
    (setvar "cmdecho" 1) (vla-endundomark adoc) 
    (princ));defun 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-endundomark adoc) 
  (vla-startundomark adoc) 
  (setvar "cmdecho" 0) 
  (setq oat (getvar "attdia") osm (getvar "osmode") 
        oaq (getvar "attreq") oqa (getvar "qaflags")) 
  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) 
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения    
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку  
  (setvar "osmode" 0) 
  (setq fpt (getpoint "\nПервый угол рамки выбора >> \n") 
               spt (getcorner fpt "\nВторой угол рамки выбора >> \n"))
  
    (if  (setq axss (ssget "_W" fpt spt (list (cons 0 "INSERT")(cons 66 1))))
      (progn
 (setq num '-1)
 (repeat (sslength axss)
   (setq blk_list (cons (vlax-ename->vla-object(ssname axss (setq num (1+ num)))) blk_list))
   )
(or rnm:Pref(setq rnm:Pref ""))(or rnm:Suf(setq rnm:Suf ""))
(setq oldPref rnm:Pref oldSuf rnm:Suf); end setq
(setq rnm:Pref (getstring T
		 (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <" rnm:Pref "> :")))
(if(= "" rnm:Pref)(setq rnm:Pref oldPref))(if(= " " rnm:Pref)(setq rnm:Pref ""))
(setq rnm:Suf (getstring T
                (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"rnm:Suf"> :")))
(if(= "" rnm:Suf)(setq rnm:Suf oldSuf))(if(= " " rnm:Suf)(setq rnm:Suf ""))
 (initget 4) 
        (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) 
        (if (not num) (setq num (if *last_number* *last_number* 
                            (getint "\n\t >> Первый раз номер задается обязательно  : "))))
        (initget "Вперед Назад") 
        (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) 
        (if (null dir) (setq dir "Вперед")) 
        (if (= dir "Вперед") (setq cm <) (setq cm >))  
        (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) 
              sort_list (vl-sort blk_list '(lambda (e1 e2) 
                          (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) 
                            (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) 
                            (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq 
        (foreach blk_obj sort_list 
          (if (and (vlax-property-available-p blk_obj 'Hasattributes) 
                   (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj)
     (= (strcase blkname)
        (strcase
   (cond
     ((and (vlax-property-available-p blk_obj 'isdynamicblock)
    (= (vla-get-isdynamicblock blk_obj) :vlax-true)
    ) ;_ end of and
      (vla-get-effectivename blk_obj)
      )
     (t (vla-get-name blk_obj))
     )
   )
        )
     )
            (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) 
              (foreach at att_list 
                (if (eq (strcase(vla-get-tagstring at))(strcase attname))
                  (progn (vla-put-textstring at (strcat rnm:Pref (itoa num) rnm:Suf)) 
                    (vla-update at) (vla-update blk_obj))))));if 
          (setq num (1+ num)));foreach 
        (setq axss nil) 
        (setq blk_list nil)));if 
  (setq *last_number* num) 
  (vla-regen adoc acactiveviewport) 
  (*error* nil) 
  (princ) 
);end 
(prompt "\nВ командной строке набери SN \n") 
(princ)

[tryba22]

VVA, проверил, работает как надо! Спасибо, огромное!
В идеале, конечно, если после рамки, была возможность довыбора блоков, либо снятия выбора с ненужных блоков.

[antiponf]

Сообщение от VVA tryba22, Добавил с другого нумератора. Не проверял, но должно работать. Перевод, если нужно, сделаешь сам. Код: [Выделить все] (defun C:SN (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm blkname attname e1 oldPref oldSuf) ;;; Vladimir Azarko (VVA) for dwr.ru ;;;http://forum.dwg.ru/showthread.php?t=5059&page=2 ;;; 11.04.20112 Добавлен префикс суффикс ;;; 17.11.2008 Добавлена обработка динамических блоков (эффективное имя) ;;; Модификация кода Лентяй, опубликованного ;;; http://dwg.ru/f/showpost.php?p=50584&postcount=37 ;;; В переменные blkname и attname вынесены названия блока и атрибута для хранения номера ;;; Полезные ссылки: ;;; Нумерация, перенумерация ;;; http://www.caduser.ru/cgi-bin/f1/boa...33416cQ&page=1 ;;; Как правильно загрузить этот лисп ;;; http://dwg.ru/art/8 (setq blkname "СВАЯ" ;_ Имя блока сваи attname "NUM" ;_ Имя аттрибута ) (vl-load-com) (defun *error* (error) (cond ((not error)) ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) (1 (princ (strcat "\nERROR: " error)))) (setvar "osmode" osm) (setvar "attdia" oat) (setvar "attreq" oaq) (setvar "qaflags" oqa) (setvar "cmdecho" 1) (vla-endundomark adoc) (princ));defun (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark adoc) (vla-startundomark adoc) (setvar "cmdecho" 0) (setq oat (getvar "attdia") osm (getvar "osmode") oaq (getvar "attreq") oqa (getvar "qaflags")) (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку (setvar "osmode" 0) (setq fpt (getpoint "\nПервый угол рамки выбора >> \n") spt (getcorner fpt "\nВторой угол рамки выбора >> \n")) (if (setq axss (ssget "_W" fpt spt (list (cons 0 "INSERT")(cons 66 1)))) (progn (setq num '-1) (repeat (sslength axss) (setq blk_list (cons (vlax-ename->vla-object(ssname axss (setq num (1+ num)))) blk_list)) ) (or rnm:Pref(setq rnm:Pref ""))(or rnm:Suf(setq rnm:Suf "")) (setq oldPref rnm:Pref oldSuf rnm:Suf); end setq (setq rnm:Pref (getstring T (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <" rnm:Pref "> :"))) (if(= "" rnm:Pref)(setq rnm:Pref oldPref))(if(= " " rnm:Pref)(setq rnm:Pref "")) (setq rnm:Suf (getstring T (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"rnm:Suf"> :"))) (if(= "" rnm:Suf)(setq rnm:Suf oldSuf))(if(= " " rnm:Suf)(setq rnm:Suf "")) (initget 4) (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) (if (not num) (setq num (if *last_number* *last_number* (getint "\n\t >> Первый раз номер задается обязательно : ")))) (initget "Вперед Назад") (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) (if (null dir) (setq dir "Вперед")) (if (= dir "Вперед") (setq cm <) (setq cm >)) (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) sort_list (vl-sort blk_list '(lambda (e1 e2) (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq (foreach blk_obj sort_list (if (and (vlax-property-available-p blk_obj 'Hasattributes) (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj) (= (strcase blkname) (strcase (cond ((and (vlax-property-available-p blk_obj 'isdynamicblock) (= (vla-get-isdynamicblock blk_obj) :vlax-true) ) ;_ end of and (vla-get-effectivename blk_obj) ) (t (vla-get-name blk_obj)) ) ) ) ) (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) (foreach at att_list (if (eq (strcase(vla-get-tagstring at))(strcase attname)) (progn (vla-put-textstring at (strcat rnm:Pref (itoa num) rnm:Suf)) (vla-update at) (vla-update blk_obj))))));if (setq num (1+ num)));foreach (setq axss nil) (setq blk_list nil)));if (setq *last_number* num) (vla-regen adoc acactiveviewport) (*error* nil) (princ) );end (prompt "\nВ командной строке набери SN \n") (princ)

А можно чтоб сначала нумерация шла сверху вниз, а только потом слева на право, и как нибудь привязать чтобы если у блока несколько видимостей, то считал блоки с одной видимостью, потом с другой и т.д.?

[d.mOnII]

что то совсем ппц
у мну динамический блоков, есть вариант установки блока по базовой точке в одну и ту же координату
но даже без этого нумератор отказывается работать
блок записываю в тело прокграммы в кавычках
тело проги на лиспе пробовалось с различных постов в том числе и из #38

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

З.Ы. при использовании лисп кода от VVA у мну в конце выдает сообщение типа блок не найден

[Кулик Алексей aka kpblc]

Теперь бы перевести этот поток букв...

[hwd]

Сообщение от d.mOnII что то совсем ппц

Абсолютный. Смысл лезть в AutoCAD, если даже писать не умеешь? Тяжко тебе будет...

[KennyMckormik]

Пользуюсь http://dwg.ru/dnl/1929 очень доволен. Есть возможность нумерации по направлению x, y прямо и обратно, без сортировки (по порядку выбора) формируется строка из изменяемых и редактируемых частей, есть проходы (цикл в цикле сначала меняется один параметр, как закончится увеличивается другой и поновой перебор) в общем мощная штука

[Alexeipost]

Сообщение от d.mOnII что то совсем ппц у мну динамический блоков, есть вариант установки блока по базовой точке в одну и ту же координату но даже без этого нумератор отказывается работать блок записываю в тело прокграммы в кавычках тело проги на лиспе пробовалось с различных постов в том числе и из #38 если кто поможет разобраться - будет очнь приятно

Граждане! Что вы накинулись на него? Человек же просит помочь разобраться! Давайте поможем!
"у мну динамический блоков" - скорее всего должно быть так "У меня есть динамические блоки".
"есть вариант установки блока по базовой точке в одну и ту же координату" - тут всё понятно вроде бы, хотя в конце надо поставить точку.
"но даже без этого нумератор отказывается работать" - Конечно слово "но" должно писаться с большой буквы. Смысл данного предложения в том, что нумератор не работает, но не понятно из-за чего. Не определено слово "этого", т.е. не понятно на что оно указывает.
"блок записываю в тело прокграммы в кавычках" - это для программистов! Программист ЛИСПа всё поймет. Я к сожалению ЛИСП не знаю, так что ничего тут не скажу. Только то, что там досадная опечатка в слове "программы".
"тело проги на лиспе пробовалось с различных постов в том числе и из #38" - указывается богатый опыт по использованию ЛИСП-программ.

Сообщение от d.mOnII хотелось бы уточнить, возможно ли сделать так: я подгружаю лисп

Можно так сделать.

Сообщение от d.mOnII ввожу команду

Можно так сделать

Сообщение от d.mOnII вбиваю превикс начальный номер и шаг

Если "превикс" это "префикс" и если поставить запятую в нужном месте, то и так можно сделать.

Сообщение от d.mOnII ставлю блок, выполняю над ним различные манипуляции (растягивание поворот видимость)

Если блок позволяет его растягивать, поворачивать и менять видимость, то можно.

Сообщение от d.mOnII затем делаю некоторые иные действия над чертежом

Некоторые действия тоже можно выполнить. Но только некоторые!

Сообщение от d.mOnII после этого снова ввожу команду (посути получается команда предназначенная для вставки определенного блока, имя которого вшито в тело лисп) и вставляю блок со следующим порядковым номером если не изменяю превикс и с новой параллельной нумерацией, если изменяю префикс и т.д.

И это тоже все можно сделать!

Сообщение от d.mOnII З.Ы. при использовании лисп кода от VVA у мну в конце выдает сообщение типа блок не найден

ЛИСП-программа сообщает, что в данном чертеже не найден блок с указанным именем (или другими проверяемыми параметрами).

[Кулик Алексей aka kpblc]

Alexeipost, объясняю два раза: первый и последний. Вот ты выступил в защиту, а теперь попробуй ответить на следующие вопросы:

1. Про какой код вообще разговор?
2. Что значит "есть вариант установки блока по базовой точке в одну и ту же координату"? Это вставка блока в одну и ту же точку? Точно не изменение параметра базовой точки?
3. "блок записываю в тело прокграммы в кавычках" - что именно записывается? Где пример dwg?
4. <...> Ну и так далее.

[d.mOnII]

простите, уважаемые филологи, за мой обыденный инет-словарный запас и три класса церковно-приходской школы
2 Alexeipost - поменьше бы сорказма в вашем посте #59, ну и побольше обобщенности, а не видирания отдельных фраз из текста, может что-то и получилось бы

ну и всех прошу простить за тот поток букв, просто больше 6-ти часов разбирался в просторах интернета с данным вопросом автонумерации блока и вот как-то по быстрому расписал проблему, в надежде, что все поймут и помогут
теперь попробую по русски отписать суть проблемы

значит так, как и у большинства здесь присутствующих, у меня возникла потребность в автонумерации блоков.
я попытался использовать предложенные коды на LISP'е, но к сожалению, ниодин не заработал.

Было бы хорошо реализовать вставку блоков, подлежащих нумерации локальными лисп командами
т.е. код от VVA на сайте http://www.caduser.ru пост #16 использовать для некоторых блоков
например (т.к. я электрик, блоки соответственно для электрики): лоток, светильник, розетку, т.е. необходимо создать три файла с кодом, в которых указать соответствующий блок и атрибут для нумерации
это не сложно, но необходимо:
1. что бы вставка блока производилось командой, например для лотка - ba_c (block add cable tray), для розетки - ba_s (block add socket) и т.д (с этим проблем нет правда библиотека лисп команд будет о-го-го ).
2. при вставке блока шел анализ существующих блоков с имеющимися префиксами (различные суфиксы не учитывались при сквозной нумерации) и при наличии таковых - нумерация продолжалась (важно что бы анализ шел только в модели активного файла а не во всех открытых)
3. ну и все же данный код так и не заработал, несмотря на то что я вставил в тело кода название своего блока и название атрибута (с учетом регистра)
получилось так:
[code]

Код:

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

  (setq apnum:Block "!_Лоток") ;_Впиши имя блока здесь (Enter a name of the block here )
  (setq apnum:tag "УЧАСТОК")       ;_Впиши имя тага атрибута (Enter a tag name of attribute

в конце концов команда выдает следующее :
1. Type prefix -> LVCT -> клик правой кнопкой мыши
2. Type suffix -> клик правой кнопкой мыши
3. Specify start number <1> -> 1 -> правый клик
4. Specify increment <1> -> 1 -> правый клик
5. Specify block scale <1.000> -> 1 -> правый клик
врезультате блок вставлен (хотя ранее писал что блок не найден), но артибут УЧАСТОК не изменен относительно значения по умолчанию, т.е. ни порядкового номера ни префикса, указанного ранее нету (по умолчанию в атрибуте стоит пустое значение, т.е. никакого текста нет)
Возможно проблема в том что акад 2011, но мне кажется проблема в прокладке между столом и стулом
подскажите что выполняется не так:?

и самое шикарное было бы, если бы при использовании команды "добавить выбранные" и выбрать соответствующий блок, запускалась автоматически команда лисп по автонумерации (естественно если блок указан в описанном выше теле кода)

[Alexeipost]

2 d.mOnII чтобы понять что Вы имели ввиду после 6-ти часов проведенных Вами на просторах интернета надо залезть к Вам в голову. Но таких технологий на этом форуме ни у кого нет (возможно они есть у ученных или спецслужб, но и там тоже необходим физический контакт с исследуемой головой). И чтобы понять, что Вам нужно необходимо это четко и ясно описать.
Представьте ситуацию, Вы пришли в магазин и позвали всех продавцов, со всех отделов и говорите: "Я 6 часов провел в интернете за изучением характеристик колбасы (тут продавцы из отдела спортивных товаров и игрушек ушли в свои отделы), но так и не смог понять какая колбаса мне нужна! Я смотрел фотографию "любительской", даже лизнул экран, но цвет у неё зеленый, хотя по форме она очень даже ничего. Нашел черенок от лопаты (формой он похож на колбасу) и начал его ножом резать. Нож выдал ошибку и отказался работать. Так вот, какую колбасу посоветуете, чтобы было так: первая отрезанная долька была квадратная (я её положу на кусочек хлеба), вторая долька круглая (она для кусочка батона), третья овальная (она для черного подового). Но если я после хлеба, захочу положить кусочек колбасы на подовый, то она тут же должна стать овальной......и пусть на каждом кусочке будет порядковый номер!"
з.ы. Услуги экстрасенсов (для того чтобы узнать что человек думает) не предлагать!
з.з.ы. За инет-словарный запас не просите! Не прощу!

2 d.mOnII
Попробуй NumincV3-3.lsp от Lee-mac.com (там он под таким названием Incremental Numbering Suite)

[d.mOnII]

не очень как то идея
то что по префиксу автоматом не анализирует порядковый номер особенно важно, когда у тебя чертеж с кабеленесущими системами разной принадлежности LVCT, MVCT и др. и надо на плане найти лоток данной системы с последним порядковым номером

а кто знает, можно ли индивидуально вшить автонумерацию в определенные блоки и что б если я просто вставлял блок любым из 4х способов срабатывала автонумерация
три способа вставки блока:
1. вставить выбранные (вставляет аналогичный объект с полным соответствием всех свойст форматирования выделенному)
2. через функцию вставка блока
3. через набор команды лисп как в кооде от VVA, описанном ранее
4. копи-паст (анализ таких же блоков с учетом префикса и добавление порядкового номера к префиксу)

[Alexeipost]

Посмотри Automatically Label Attributes у того же Lee Mac.
Сделай несколько лиспов с разными командами. В каждый лисп пропиши свой блок (надо чтобы LVCT и MVCT были блоками с разными именами).

з.ы. А вообще это больше похоже на поиск большой красной кнопки...

[VVA]

Сообщение от d.mOnII Было бы хорошо реализовать вставку блоков, подлежащих нумерации локальными лисп командами т.е. код от VVA на сайте http://www.caduser.ru пост #16 использовать для некоторых блоков

Это ссылка на один из первых вариантов BINC.
Вариант BINC с запросом блока и выбором атрибута
+ добавил обработку имен динамических блоков

[d.mOnII]

Сообщение от VVA Это ссылка на один из первых вариантов BINC. Вариант BINC с запросом блока и выбором атрибута + добавил обработку имен динамических блоков

Владимир, Спасибо супер, но все же не идет анализ по префиксам, т.е. что бы мне назначить начало нумерации необходимо ручками посчитать количество или найти максимальное значение с данным префиксом
а вот все же забиндить данный код под конкретный блок я не нашел где это касательно

Сообщение от d.mOnII 1. что бы вставка блока производилось командой, например для лотка - ba_c (block add cable tray), для розетки - ba_s (block add socket) и т.д (с этим проблем нет правда библиотека лисп команд будет о-го-го ).

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

не совсем понимаю сообщение (If you want to delete prefix type ' ' (press SPACE key on keyboard)

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

[Alexeipost]

КЖ долго корректировать?
Сделай так чтобы КЖ делался на основе данных из автокада! - Я делаю так: автокад(извлечение данных)-эксель(обработка и создание нужного представления)-автокад(связь с данными).

[zamtmn]

d.mOnII
У вас в корне неправильный подход. расставляете, потом обзываете и нумеруете. Нумерация и присвоение имен в рантайме необосновано усложняет программу и процесс внесения изменений в чертеж, а проку никакого не приносит

[d.mOnII]

это невозможно
поверьте, когда 1000 трасс то привязать каждый кабель к 20ти трассам - это нереально поэтому:
автоматически нумерованнае трассы в виде блока лотка
затем извлечение данных в ексель для определения длин лотка и самих участков в виде горизонтали
после этого извлечение данных по кабелям (обозначениям трасс), далее присваивание каждой трассе положенных участков
после этого формируем КЖ с указанием обозначения трассы, начала/конца трассы, общей расчетной длины, перечисления участков, через которые проходит трасса

отсюда и требование к периодам, когда можно и нужно вносить корректировку участков
(пример КЖ сбрасывать не буду )


в какмом рантайме:? что это такое

(по поводу правильности подхода или неправильности думаю тут судить мне, т.к. ни один проект уже сделан)
а в рееальности, последний объект получился на 1280 позиций, с учетом текущих изменений образовалось 20% дыр в нумерации

[Alexeipost]

Это какая область? ОПС, КИПиА, СКС?
И вообще это проектирование или конструирование?

[d.mOnII]

проектирование
у меня СКС, РРЛ, ПС, ЭО, ЭМ, ЭС, СС

только, прошу, тут тема про LISP а не правила выполнения проектов, каждый сам для себя определяет как правильно, а учитывая что большинство забивают на правила ГОСТ, то думаю, мнение окружающих по поводу правил оформления ПСД будем рассматривать в других темах

[Alexeipost]

Чем больше данных в проекте, тем больше расхождений в натуре - тем больше вносить исправлений (или тем больше отличается исполнительная).
Представляю сколько страниц занимает КЖ?!
Я делаю КЖ так: кабель - откуда(помещение,оборудование,порт) - куда (помещение, номер розетки) - тип кабеля - длина - примечание.
Если вводить ещё участки трасс, через которые проходит кабель, то 1800 кабелей будет гораздо больше чем 60 листов.....

з.ы. Выполнять современную ПСД по ГОСТам прошлого века? Ну-ну.....

[d.mOnII]

Сообщение от Alexeipost з.ы. Выполнять современную ПСД по ГОСТам прошлого века? Ну-ну.....

не в этой теме
хотите поговорить о этом skype d.monii
очень жду комментария Владимира VVA, гуру Lisp'ы

[zamtmn]

>>в какмом рантайме:? что это такое

2. при вставке блока шел анализ существующих блоков с имеющимися префиксами (различные суфиксы не учитывались при сквозной нумерации) и при наличии таковых - нумерация продолжалась (важно что бы анализ шел только в модели активного файла а не во всех открытых)

я имею ввиду определение "номера" в момент вставки. Что мешает расставить, а вотом пронумеровать?

[Alexeipost]

Сообщение от d.mOnII а в рееальности, последний объект получился на 1280 позиций, с учетом текущих изменений образовалось 20% дыр в нумерации

1280 позиций - это количество телефонных (или других видов) розеток или просто 60 кабелей. И каждый кабель занимает по 20 строк в КЖ?

[d.mOnII]

еще раз!

Сообщение от d.mOnII не в этой теме хотите поговорить о этом skype d.monii очень жду комментария Владимира VVA, гуру Lisp'ы

[Nike]

http://www.cad.ru/ru/forum/index.php...1892&PAGEN_1=3

[d.mOnII]

2 nike
читайте внимательней ВЫШЕ

[Nike]

d.mOnII, что?

а кто знает, можно ли индивидуально вшить автонумерацию в определенные блоки и что б если я просто вставлял блок любым из 4х способов срабатывала автонумерация три способа вставки блока: 1. вставить выбранные (вставляет аналогичный объект с полным соответствием всех свойст форматирования выделенному) 2. через функцию вставка блока 3. через набор команды лисп как в кооде от VVA, описанном ранее 4. копи-паст (анализ таких же блоков с учетом префикса и добавление порядкового номера к префиксу)

По ссылке программа, которая ваши требования выполняет.

Вставляет аналогичный выбранному блок (1) через функцию вставки (2) с помощью LISP (3) c учетом префикса и добавление порядкового номера к префиксу (4).
Все в одном флаконе.

Спасибо сказал бы, что-ли...

[zamtmn]

d.mOnII
Оригинальный способ общения.
-Надо так и всё тут
-А может так? и вообще почему так а не так?
-см.выше (=отвали)

-Посмотри вот это
-см.выше (=отвали)

Удачного проектирования и нумерации!

[d.mOnII]

2 zamtmn
прошу прощения, если кого чем обидел, но:
я могу долго писать одно и тоже, но это не решит вопроса, так что не надо переворачивать
если пользователь только вошел в тему и решил поумничать или отписаться для галочки, то ну и ладно, но это лишнее, выше написан вопрос и некоторые аспекты существующих кодов
готовые варианты предложенные ранее проверены и не подходят, поэтому и прошу помочь, оговаривая, собственно, каждые моменты
или может необходимо сосдать один пост в котором перечислить все коды, которые пробовал:? со всех сайтов

2 Nike

По ссылке программа, которая ваши требования выполняет. Вставляет аналогичный выбранному блок (1) через функцию вставки (2) с помощью LISP (3) c учетом префикса и добавление порядкового номера к префиксу (4). Все в одном флаконе. Спасибо сказал бы, что-ли...

Вы, пожалуйста, Сами попробуйте данный код и поймете что он не выполняет те функции, которые описаны выше

[Alexeipost]

Сталину доложили, что обнаружился его двойник.
- Расстрелять! - приказал Сталин.
- А, может, сбрить усы, товарищ Сталин?
- Ну, можно и так.

Это к тому что "я так много раз делал и впредь делать буду! И по-другому меня не учите!"

[Nike]

Сообщение от d.mOnII 2 Nike Цитата: По ссылке программа, которая ваши требования выполняет. Вставляет аналогичный выбранному блок (1) через функцию вставки (2) с помощью LISP (3) c учетом префикса и добавление порядкового номера к префиксу (4). Все в одном флаконе. Спасибо сказал бы, что-ли... Вы, пожалуйста, Сами попробуйте данный код и поймете что он не выполняет те функции, которые описаны выше

Ну, ладно, прости меня, дурака глупого.
Читал-читал твои "те функции, которые описаны выше" и так и нихрена не понял чё надо-то? Чтобы автокад за тебя все молча нумеровал?

А так сойдет -

???????µ???°?†???? ???·???µ?‰?°?‚?µ?»?µ??.avi

http://www.youtube.com/watch?v=-3YaCj9qu5g ?

[d.mOnII]

просто в офигенное русло перешел разговор

[zamtmn]

d.mOnII
>>я могу долго писать одно и тоже, но это не решит вопроса, так что не надо переворачивать
Да ты можешь. А можешь один раз нормально описать что надо и приложить пример что есть и как надо?

[d.mOnII]

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

обобщаю (надеюсь так будет более понятно что я пытался спросить ранее)

Способ 1 (наверно самый сложный либо невозможный, этого я не знаю)

Сообщение от d.mOnII а кто знает, можно ли индивидуально вшить автонумерацию в определенные блоки и что б если я просто вставлял блок любым из 4х способов срабатывала автонумерация тричетыре способа вставки блока: 1. вставить выбранные/ADDSELECTED (вставляет аналогичный объект с полным соответствием всех свойст форматирования выделенному) [в каде появилась данная функция начиная с 2011] 2. через функцию вставка блока 3. через набор команды лисп как в кооде от VVA, описанном ранее 4. копи-паст (анализ таких же блоков с учетом префикса и добавление порядкового номера к префиксу)

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

либо

Способ 2 (частично реализован в ранее предоставленных кодах ссылки на который размещены в данной теме от пользователей)

Сообщение от d.mOnII 1. что бы вставка блока производилось командой, например для лотка - ba_c (block add cable tray), для розетки - ba_s (block add socket) и т.д (с этим проблем нет правда библиотека лисп команд будет о-го-го ). 2. при вставке блока шел анализ существующих блоков с имеющимися префиксами (различные суфиксы для вычленения различных последовательностей автонумерации) и при наличии таковых - нумерация продолжалась (важно что бы анализ шел только в модели активного файла а не во всех открытых файлах)

Наиболее удачный код, который по моему мнению подходит для выполнения задач, от пользователя VVA "bink" из сообщения на http://www.caduser.ru ИМХО

Код:

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

(defun c:binc (/ oldStart oldPref oldSuf oldEcho oldInc
        oldSize oldBlock temBl *error* att attr apnum:tag pt)
  ;====================================================================
  (setq apnum:Block "BlockName") ;_Впиши имя блока здесь (Enter a name of the block here )
  (setq apnum:tag "Nomer")       ;_Впиши имя тага атрибута (Enter a tag name of attribute)
  ;===================================================================
;==== Local functions ============
  (defun *error* (msg)(setvar "CMDECHO" oldEcho)(setvar "ATTDIA" att)(setvar "ATTREQ" attr)(princ)); end *error*
  (defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
        ((null dat)(setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))))
;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;                 Tag_Name - string
;;                    Value - string
(defun mip-block-setattr-bylist (obj att_list / txt lst)
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list))
  (if (and obj
           (not(vlax-erased-p obj))
           (= (vla-get-ObjectName obj) "AcDbBlockReference")
      (eq :vlax-true (vla-get-HasAttributes obj))
      (vlax-property-available-p obj 'Hasattributes)
      (vlax-write-enabled-p obj)
      )
    (vl-catch-all-apply
      (function
   (lambda   ()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
              (vla-put-TextString at (cdr lst))
            )
            )
          )
        )
      )
    )
  )
;==== Local functions END ============
  (if(not apnum:Size)(setq apnum:Size 1.0))
  (if(not apnum:Num)(setq apnum:Num 1))
  (if(not apnum:Inc)(setq apnum:Inc 1))
  (if(not apnum:Pref)(setq apnum:Pref ""))
  (if(not apnum:Suf)(setq apnum:Suf ""))
  (setq  oldStart apnum:Num oldSize apnum:Size oldInc apnum:Inc
         oldPref apnum:Pref oldSuf apnum:Suf
         apnum:Block (mip-conv-to-str apnum:Block)
         apnum:tag (mip-conv-to-str apnum:tag)
         oldEcho (getvar "CMDECHO")
         att (getvar "ATTDIA") attr (getvar "ATTREQ")); end setq
  (setvar "ATTDIA" 0)(setvar "ATTREQ" 0)
  (setvar "CMDECHO" 0)
    (setq apnum:Pref
    (getstring T
      (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Pref"> :")))
  (if(= "" apnum:Pref)(setq apnum:Pref oldPref))
  (if(= " " apnum:Pref)(setq apnum:Pref ""))
  (setq apnum:Suf
    (getstring T
       (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Suf"> :")))
  (if(= "" apnum:Suf)(setq apnum:Suf oldSuf))
  (if(= " " apnum:Suf)(setq apnum:Suf ""))
  (setq apnum:Num
    (getint
      (strcat "\nSpecify start number <"(itoa apnum:Num)">: ")))
  (if(null apnum:Num)(setq apnum:Num oldStart))
  (setq apnum:Inc
    (getint
      (strcat "\nSpecify increment <"(itoa apnum:Inc)">: ")))
  (if(null apnum:Inc)(setq apnum:Inc oldInc))
  (setq apnum:Size
    (getreal
      (strcat "\nSpecify block scale <"(rtos apnum:Size)">: ")))
  (if(null apnum:Size)(setq apnum:Size oldSize))
  (if apnum:Block(setq oldBlock apnum:Block))
;;;  (setq temBl
;;;     (entsel(strcat "\nSelect block <"
;;;         (if apnum:Block apnum:Block "not difined") "> > "))); end setq
  (cond
    ((null (tblsearch "BLOCK" apnum:Block))
     (alert (strcat "Block " apnum:Block " not found"))
     (setq apnum:Block nil)
     ); end condition #0
    ((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block))
    (setq apnum:Block oldBlock)
     ); end condition #1
    ((and tembl (= 1 (cdr(assoc 66(entget(car temBl))))))
    (setq apnum:Block(cdr(assoc 2(entget(car temBl)))))
    ); end condition #2
    (t
     (princ "\nBlock not contains attribute! ")
     (setq apnum:Block nil)
     ); end condition #3
    ); end cond
  (if apnum:Block
    (progn
(while T
  (princ "\n>>> Pick insertion point or press Esc to quit <<<\n")
  (command "_-insert" apnum:Block "_s" apnum:Size pause "0")
   (mip-block-setattr-bylist (entlast)
     (list(cons (strcase (mip-conv-to-str apnum:tag))
                (strcat apnum:Pref(itoa apnum:Num)apnum:Suf))))
    (setq apnum:Num (+ apnum:Num apnum:Inc))
  ); end while
); end progn
    ); end if
  (setvar "ATTDIA" att)(setvar "ATTREQ" attr)
  (princ)
  )

З.Ы. возможно ли как-то решить вопрос с появлением дыр в последовательности при удалении того или иного блока - не обязательно
возможно ли как-то решить вопрос с тем, что код не анализирует существующие блоки и автонумерацию поддерживает только в пределах одной сесси (такое не со всеми кодами), потом необходимо заново искать последний номер последовательности и стартовую цифру вводить самому


=========================06.02.2013=====================================

Прошу прощения, что не дожидаясь ответа снова пишу, но хотелось бы уточнить, я что-то в данном посте снова не так написал:? или просто вопросы не решаемы?

[gest]

Уважаемый VVA не подскажете по sn из поста №40, идет такая нумерация
Рамка сверху-влево-вниз
http://forum.dwg.ru/attachment.php?a...1&d=1377080396
Рамка сверху-справа-вниз
http://forum.dwg.ru/attachment.php?a...1&d=1377080396

Версия sn1 расставляет нумерацию нормально, но нет возможности выбора рамкой
http://forum.dwg.ru/attachment.php?a...1&d=1377081089

[Ilez]

Сообщение от Alan Вообще-то количество букв ограничено... Но никто вам не мешает использовать список Букв Код: [Выделить все] (setq MList '(А Б В Г Д Е Ж И К Л М Н П Р С Т У Ф Х Ц Ч Ш Щ Э Ю Я)) ;;;с последовательным выбором из списка (setq marka (nth i Mlist)) ;;; ,где i - счетчик цикла

за место чего вставлять этот код, чтобы нумеровать по буквам? Меня интересует обычный нумератор текста, например из #43.
Offtop: Вообще не разбираюсь в лиспе

[san40]

Для нумерации пользуюсь бесплатным расширением автокада "increment" с оф. сайта, для большинства базовых задач - вполне.
Вот здесь подробнее:
https://apps.autodesk.com/ACD/ru/Det...increment%3aen

[Alan]

Сообщение от Ilez за место чего вставлять этот код, чтобы нумеровать по буквам?

Я отвечал на п.46

Сообщение от v_alex но не нашел возможности нумеровать атрибуты буквами А, Б, В и так далее... в общем хочется блоки осей нумеровать...

[Ilez]

Сообщение от san40 Для нумерации пользуюсь бесплатным расширением автокада "increment" с оф. сайта, для большинства базовых задач - вполне. Вот здесь подробнее: https://apps.autodesk.com/ACD/ru/Det...increment%3aen

Спасибо, посмотрел - интересный функционал, но насколько я понял там последовательность А, Б, В, Г, Д, ... не задаётся, только английская А...Z.

Сообщение от Alan Я отвечал на п.46

Да я знаю. Я имел ввиду куда бы подставить ваш массив (в какой части нумератора, хоть простейшего), чтобы им воспользоваться. Сам я вообще не ориентируюсь в коде, поэтому задаю столь элементарный вопрос.

[greyser]

Сообщение от VVA tryba22, Добавил с другого нумератора. Не проверял, но должно работать. Перевод, если нужно, сделаешь сам. Код: [Выделить все] (defun C:SN (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm blkname attname e1 oldPref oldSuf) ;;; Vladimir Azarko (VVA) for dwr.ru ;;;http://forum.dwg.ru/showthread.php?t=5059&page=2 ;;; 11.04.20112 Добавлен префикс суффикс ;;; 17.11.2008 Добавлена обработка динамических блоков (эффективное имя) ;;; Модификация кода Лентяй, опубликованного ;;; http://dwg.ru/f/showpost.php?p=50584&postcount=37 ;;; В переменные blkname и attname вынесены названия блока и атрибута для хранения номера ;;; Полезные ссылки: ;;; Нумерация, перенумерация ;;; http://www.caduser.ru/cgi-bin/f1/boa...33416cQ&page=1 ;;; Как правильно загрузить этот лисп ;;; http://dwg.ru/art/8 (setq blkname "СВАЯ" ;_ Имя блока сваи attname "NUM" ;_ Имя аттрибута ) (vl-load-com) (defun *error* (error) (cond ((not error)) ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) (1 (princ (strcat "\nERROR: " error)))) (setvar "osmode" osm) (setvar "attdia" oat) (setvar "attreq" oaq) (setvar "qaflags" oqa) (setvar "cmdecho" 1) (vla-endundomark adoc) (princ));defun (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark adoc) (vla-startundomark adoc) (setvar "cmdecho" 0) (setq oat (getvar "attdia") osm (getvar "osmode") oaq (getvar "attreq") oqa (getvar "qaflags")) (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку (setvar "osmode" 0) (setq fpt (getpoint "\nПервый угол рамки выбора >> \n") spt (getcorner fpt "\nВторой угол рамки выбора >> \n")) (if (setq axss (ssget "_W" fpt spt (list (cons 0 "INSERT")(cons 66 1)))) (progn (setq num '-1) (repeat (sslength axss) (setq blk_list (cons (vlax-ename->vla-object(ssname axss (setq num (1+ num)))) blk_list)) ) (or rnm:Pref(setq rnm:Pref ""))(or rnm:Suf(setq rnm:Suf "")) (setq oldPref rnm:Pref oldSuf rnm:Suf); end setq (setq rnm:Pref (getstring T (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <" rnm:Pref "> :"))) (if(= "" rnm:Pref)(setq rnm:Pref oldPref))(if(= " " rnm:Pref)(setq rnm:Pref "")) (setq rnm:Suf (getstring T (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"rnm:Suf"> :"))) (if(= "" rnm:Suf)(setq rnm:Suf oldSuf))(if(= " " rnm:Suf)(setq rnm:Suf "")) (initget 4) (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) (if (not num) (setq num (if *last_number* *last_number* (getint "\n\t >> Первый раз номер задается обязательно : ")))) (initget "Вперед Назад") (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) (if (null dir) (setq dir "Вперед")) (if (= dir "Вперед") (setq cm <) (setq cm >)) (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) sort_list (vl-sort blk_list '(lambda (e1 e2) (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq (foreach blk_obj sort_list (if (and (vlax-property-available-p blk_obj 'Hasattributes) (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj) (= (strcase blkname) (strcase (cond ((and (vlax-property-available-p blk_obj 'isdynamicblock) (= (vla-get-isdynamicblock blk_obj) :vlax-true) ) ;_ end of and (vla-get-effectivename blk_obj) ) (t (vla-get-name blk_obj)) ) ) ) ) (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) (foreach at att_list (if (eq (strcase(vla-get-tagstring at))(strcase attname)) (progn (vla-put-textstring at (strcat rnm:Pref (itoa num) rnm:Suf)) (vla-update at) (vla-update blk_obj))))));if (setq num (1+ num)));foreach (setq axss nil) (setq blk_list nil)));if (setq *last_number* num) (vla-regen adoc acactiveviewport) (*error* nil) (princ) );end (prompt "\nВ командной строке набери SN \n") (princ)

Спасибо большое за нумератор!
Можно ли модифицировать программу, чтобы при выполнении она запрашивала блок и атрибут. А то при нумерации разных блоков приходится каждый раз править код

upd
нашел тут #29 http://forum.dwg.ru/showthread.php?t=46382&page=2

[ltnchik1405]

Приходится чертить в AutoCAD LT. Как в нём автоматизировать этот нудный процесс?

[Alexeipost]

Никак.
Вообще никак.
НИКАК!
ВООБЩЕ НИКАК!
НИ-КАААААК.....

[ltnchik1405]

Сообщение от Alexeipost Никак. Вообще никак. НИКАК! ВООБЩЕ НИКАК! НИ-КАААААК.....

Ругаюсь матом.

[Alexeipost]

Поставь нормальный Автокад

[ltnchik1405]

Организация. Нет прав.

[Сергей812]

в ЛТ можно автоматизировать что-то только путем эмуляции ввода пользователя в комстроку. Т.е. отрисовать что-то можно - а какое либо интерактивное взаимодействие с пользователем и чертежом никак.

[Boxa]

ltnchik1405, нет прав на установку и запуск сторонних программ или нет прав на покупку? Я краем уха слышал, что бывают портабле версии кад программ, которые можно запускать прямо с флешки....

[ltnchik1405]

Сообщение от Boxa нет прав на установку и запуск сторонних программ или нет прав на покупку?

И то и другое.

Сообщение от Boxa портабле версии

Пробовал. Доктор Веб считает их вирусами.

[Boxa]

Сообщение от ltnchik1405 И то и другое.

Тогда остается только страдать или менять работу.
ИМХО, если работоВзятель не понимает необходимость автоматизации/ускорения рабочего процесса и тем более экономит на нормальном софте, то ничего хорошего ждать не стоит.

[maratovich]

Сообщение от ltnchik1405 Пробовал. Доктор Веб считает их вирусами.

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

[ltnchik1405]

Сообщение от maratovich Портабл, это не с торента, а с официального сайта. Народ привык что портабл это эмулятор с лекарством, а реально это просто набор файлов без установки.

Существует портабл автогада на сайте аутодеск? Не знал про такое. Ссылкой поделись, сам не нашёл.

[koMon]

очень сомнительно что там есть портабл...

[Сергей812]

нет такого. Можно посмотреть в сторону бесплатного 5 нанокада, например - если еще ограничений не ввели по лицензированию бесплатных версий.

[ltnchik1405]

Не дают бесплатных лицензий Нанокадовцы.

[Boxa]

Сообщение от ltnchik1405 Не дают бесплатных лицензий Нанокадовцы.

Разве? https://www.nanodev.ru/products/free/

[gip_gip]

Может кто поможет? Модификация команды Копировать.
Есть набор помещений. Рисую кружочек, ставлю номер внутрь. Далее копирую в другие помещения, (выполняя свой макрос). Работает. Но, только один раз. Как сделать цикл всего процесса? Куда звездочку воткнуть? Или как-то по другому?
Редакция команды copy:
$M=$(if,$(eq,$(substr,$(getvar,cmdnames),1,4),GRIP),_copy,^C^C_copy _C \\ \\_textedit _l)
Пробовал * везде поставить. Может, принципиально не туда шагаю?

----- добавлено через ~2 ч. -----
*^C^C_copy _C \\ \\_textedit
Хотя бы так. Все-таки маленько проще.

[Alexeipost]

2 gip_gip
Пробовал NumInc от lee-mac точка com?
Лично я сделал блок с атрибутами и этой программой автонумерации вставляю его.

[skkkk]

Alexeipost, есть же вот в этой программе возможность и тексты и Мтексты вставлять. Речь об этом, верно? Incremental Numbering Suite
Но пользоваться блоком, состоящим из круга и атрибута, конечно, правильнее.

[Alexeipost]

Сообщение от skkkk Alexeipost, есть же вот в этой программе возможность и тексты и Мтексты вставлять. Речь об этом, верно? Incremental Numbering Suite Но пользоваться блоком, состоящим из круга и атрибута, конечно, правильнее.

Этой прогой можно и блоки вставлять, и выбирать нужный атрибут в блоке, который будет увеличиваться.
Причем как цифры, так и буквы.
Можно и перенумерацию делать: после того как настроил как надо нумеровать и вышел в чертеж для вставки нажимаешь R и указываешь текст/мультитекст/атрибут блока который надо перенумеровать