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

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

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

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

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

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

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

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

Если не сложно помогите пожалуйста господа профи.
[ATTACH]1135575294.jpg[/ATTACH]
[ATTACH]1135575325.jpg[/ATTACH]
Просмотров: 71525
 
Непрочитано 26.12.2005, 11:38
#2
sv_ispu

проектирование,монтаж,наладка
 
Регистрация: 14.11.2005
Иваново
Сообщений: 20
<phrase 1=


express tools -> text -> automatic text numbering...
или посмотри на autocad.ru в форуме. Эта проблема стопудово обсуждалась...
sv_ispu вне форума  
 
Непрочитано 26.12.2005, 12:40
#3
Alan

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


>Diman111
Как раз по сваям делал
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=868uY
Alan вне форума  
 
Автор темы   Непрочитано 26.12.2005, 14:03
#4
Diman111

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


Цитата:
Сообщение от Alan
>Diman111
Как раз по сваям делал
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=868uY
К сожалению ссылка на не совсем бесплатную программу,
и прога имеет существенный недостаток - она не позволяет пробить все поле автоматически - приходится каждый раз указывать номер 1 - 10 -30 и т.д. менять направдение оси - по возрастанию или убыванию - в общем не совсем то но близко. для поля из 20-30 блоков подходяще.

може все же кто то сможет написать лисп а - господа программисты !!??
Diman111 вне форума  
 
Непрочитано 26.12.2005, 14:04
#5
fixo

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


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

Код:
[Выделить все]
(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'~
fixo вне форума  
 
Автор темы   Непрочитано 26.12.2005, 14:14
#6
Diman111

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


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

надеюсь не обнаглел
Diman111 вне форума  
 
Непрочитано 26.12.2005, 14:43
#7
fixo

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


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

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

'J'~~
fixo вне форума  
 
Непрочитано 26.12.2005, 15:05
#8
Alan

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


>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 вне форума  
 
Непрочитано 26.12.2005, 15:06
#9
Alan

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


>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 вне форума  
 
Автор темы   Непрочитано 26.12.2005, 15:39
#10
Diman111

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


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

Command: Chan_Numb

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

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

Заменены номера у 0 свай
Command:

я и имя блока поменял на S1 (у вас в коде вроде бы фильтрются блоки по имени)- результат тот же
Diman111 вне форума  
 
Непрочитано 26.12.2005, 15:56
#11
Alan

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


Шлите файл
Alan вне форума  
 
Автор темы   Непрочитано 26.12.2005, 15:59
#12
Diman111

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


Цитата:
Сообщение от Alan
Шлите файл
Выслал
Diman111 вне форума  
 
Непрочитано 26.12.2005, 16:24
#13
VVA

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


Попробуй следующую модификацию программы 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)
VVA вне форума  
 
Непрочитано 26.12.2005, 19:33
#14
Alan

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


>Diman111
19-35 Файл не получил. Попробуйте направить на alnaz2004(A)mail.ru
Alan вне форума  
 
Непрочитано 26.12.2005, 19:37
#15
fixo

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


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

Код:
[Выделить все]
(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'~
fixo вне форума  
 
Непрочитано 26.12.2005, 21:24
#16
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,283


А мне больше нравится Sheet Set с Fieldсами
asys вне форума  
 
Автор темы   Непрочитано 27.12.2005, 08:35
#17
Diman111

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


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

И СПАСИБО ВСЕМ КТО ОТКЛИКНУЛСЯ.
Diman111 вне форума  
 
Автор темы   Непрочитано 27.12.2005, 08:36
#18
Diman111

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


Цитата:
Сообщение от Asys
А мне больше нравится Sheet Set с Fieldсами
Прости за незнание - С ЧЕМ??? - может небольшой ликбез а ...
Diman111 вне форума  
 
Непрочитано 27.12.2005, 10:18
#19
Лентяй

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


Цитата:
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
Лентяй вне форума  
 
Непрочитано 27.12.2005, 10:26
#20
Alan

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


>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 по ТИпаМ примитивов и СЛОЯМ
Alan вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите плиз с программкой по автоматической нумерации

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

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