| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите плиз с программкой по автоматической нумерации

Помогите плиз с программкой по автоматической нумерации

Ответ
Поиск в этой теме
Непрочитано 26.12.2005, 08:34
Помогите плиз с программкой по автоматической нумерации
Diman111
 
промышл проектант
 
Изовсехщелей
Регистрация: 26.05.2005
Сообщений: 323

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

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

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

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

Если не сложно помогите пожалуйста господа профи.
[ATTACH]1135575294.jpg[/ATTACH]
[ATTACH]1135575325.jpg[/ATTACH]
Просмотров: 71539
 
Автор темы   Непрочитано 27.12.2005, 10:37
#21
Diman111

промышл проектант
 
Регистрация: 26.05.2005
Изовсехщелей
Сообщений: 323


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

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


>Alan А моя прога буквы игнорирует, что русские, что латинские, что какие
Лентяй вне форума  
 
Автор темы   Непрочитано 27.12.2005, 10:43
#23
Diman111

промышл проектант
 
Регистрация: 26.05.2005
Изовсехщелей
Сообщений: 323


Цитата:
Сообщение от Alan
>Diman111
Прошёлся своей программкой по Вашему чертежу, в верхней части (блок начинается с латинской буквы с) всё работает.
Для того чтобы работала нижняя часть (блок называется "Свая С1" с русской буквы с) добавьте строку в анализ.
Спасибо - это то что нужно - учитывает и направление оси - против или по оси и саму ось - Х или Y.
)))
Diman111 вне форума  
 
Непрочитано 27.12.2005, 10:44
#24
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Diman111: ваша программа к сожалению не позволяет выделять рамкой
Тут мы вас, господин хороший, по-товарищески поправим. Программа писалась дл определения исходной нумерации вручную. НО! Единожды установленные (например, программой Fatty) номера для перенумеровки могут выбираться рамкой или секрамкой.
Лентяй вне форума  
 
Непрочитано 27.12.2005, 11:15
#25
Alan

CAD
 
Регистрация: 28.08.2003
Киев
Сообщений: 1,835
<phrase 1=


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

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


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

Код:
[Выделить все]
; переменную *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'~
fixo вне форума  
 
Автор темы   Непрочитано 27.12.2005, 15:35
#27
Diman111

промышл проектант
 
Регистрация: 26.05.2005
Изовсехщелей
Сообщений: 323


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

Пологаю вы, Уважаемый Fatty, помогли не только мне
Diman111 вне форума  
 
Непрочитано 27.12.2005, 16:34
#28
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Пока достучался до сайта уже все написали
Еще одна модификация программы 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)
VVA вне форума  
 
Непрочитано 27.12.2005, 18:07
#29
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Цитата:
Сообщение от Diman111
Большое пребольшое спасибо
Все как и хотел ))

Пологаю вы, Уважаемый Fatty, помогли не только мне
Буду рад если и работать будет как надо,
не всегда есть время, чтобы обкатать достаточно...

fixo вне форума  
 
Автор темы   Непрочитано 28.12.2005, 08:58
#30
Diman111

промышл проектант
 
Регистрация: 26.05.2005
Изовсехщелей
Сообщений: 323


Уважаемый VVA - ваша модификация очень хороша но есть один ньюанс - она нумерует только снизу вверх - а если мне хочется сверху вних змейку строить или еще как - такого диалога не предусмотрена и направление выделения программка не контролирует к сожалению.
и не совсем понятен смысл запроса о допуске - что за допуск ?
Diman111 вне форума  
 
Непрочитано 28.12.2005, 10:37
#31
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


>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)
Должно работать (я так думаю ).
Лентяй вне форума  
 
Автор темы   Непрочитано 28.12.2005, 13:11
#32
Diman111

промышл проектант
 
Регистрация: 26.05.2005
Изовсехщелей
Сообщений: 323


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

Command: _appload 1.lsp successfully loaded.


Command: ; error: syntax error

Command:
Diman111 вне форума  
 
Непрочитано 28.12.2005, 19:43
#33
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Diman111: Command: ; error: syntax error
Ну и сволочь она после этого ! Ну, ничего, сегодня работы немного - поковыряюсь
Лентяй вне форума  
 
Непрочитано 28.12.2005, 20:40
#34
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Исправленному верить. Лентяй
Код:
[Выделить все]
(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)
Лентяй вне форума  
 
Автор темы   Непрочитано 29.12.2005, 09:32
#35
Diman111

промышл проектант
 
Регистрация: 26.05.2005
Изовсехщелей
Сообщений: 323


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

и т.д.
Diman111 вне форума  
 
Непрочитано 29.12.2005, 11:09
#36
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


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

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Ну, вот 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)
Все, ушел спать!
Лентяй вне форума  
 
Непрочитано 05.10.2008, 12:14
1 | #38
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


К вопросу отсюда
Модификация команды из #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)
Вложения
Тип файла: dwg
DWG 2004
Сваи.dwg (32.3 Кб, 3097 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 05.10.2008 в 12:21.
VVA вне форума  
 
Непрочитано 14.11.2008, 16:05
1 | #39
SLADE

проектировщик-новобранец
 
Регистрация: 14.09.2005
Minsk
Сообщений: 324


VVA выкладываю свой блок (свая) - динамический.
Лисп отлично срабатывает при начальном положении дин. параметров (считает), но как только я переняю какой-нибудь дин. параметр (потяну за ручку или перемещу арибут, так лисп игнарирует этот блок (невидит) и пропускает его. Надеюсь понятно "раслумачыу" ?
Вложения
Тип файла: dwg
DWG 2004
Свая забивная и буронабивная.dwg (55.7 Кб, 2963 просмотров)
SLADE вне форума  
 
Непрочитано 17.11.2008, 18:36
2 | #40
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


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)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 08.02.2016 в 14:21.
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите плиз с программкой по автоматической нумерации

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск