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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Нумерация дин.блоков "тыкая" мышью

Нумерация дин.блоков "тыкая" мышью

Ответ
Поиск в этой теме
Непрочитано 27.11.2008, 09:44 #1
Нумерация дин.блоков "тыкая" мышью
gizmo_zx
 
Проектировщик ЭО,ЭМ, ЭОС
 
Нижний Новгород
Регистрация: 18.07.2007
Сообщений: 247

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

нашел только это, но всвязи с большой кривизной рук и головного мозга поправить не в состоянии. Буду длагодарен за любую помошь.
Код:
[Выделить все]
(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://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))
   )
 (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)
Просмотров: 5254
 
Непрочитано 27.11.2008, 10:00
#2
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Я, например, сделал так.
В дин. блоке есть параметр "Наименование". Я в одном блоке проставляю номер (позицию) в атрибут. Потом запускаю прогу, указываю на блок и номер автоматически проставляется для всех блоков, имеющих в параметре "Наименование" то же значение.

Если интересно, то могу выложить код. Хотя он не для широких масс, потому что требует, чтобы блоки конструировались по определённым правилам. (т.е. имели бы параметр "Наименование", который был бы ещё осмысленым).

ЗЫ В принципе, если надо, то не проблема переделать код так, чтобы прога отбирала блоки не по параметру, а по имени. Т.е. более универсальный случай.
Makswell вне форума  
 
Автор темы   Непрочитано 27.11.2008, 10:09
#3
gizmo_zx

Проектировщик ЭО,ЭМ, ЭОС
 
Регистрация: 18.07.2007
Нижний Новгород
Сообщений: 247
<phrase 1= Отправить сообщение для gizmo_zx с помощью Skype™


мне бы конечно хотелось не автоматическую нумерацию выделенных блоков (т.к. отсутствует их логика при нумерации), а именно "тыканьем".
Если не сложно выложи свой код...
gizmo_zx вне форума  
 
Непрочитано 27.11.2008, 10:12
#4
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Вот код, которым я пользуюсь:
Код:
[Выделить все]
(defun C:M_Rewrite_pos
		       (/	      M-vla_Document
			M-vla_ModelSpace	    BlkRef	  b_name
			lst_temp      naimenov	    lst		  flag
		       )
  (vl-load-com)
  (setq M-vla_Document (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq M-vla_ModelSpace (vla-get-ModelSpace M-vla_Document))
  (setq BlkRef (vlax-ename->vla-object (car (entsel "Выбери блок:"))))
  (setq b_name (vla-get-EffectiveName BlkRef))
  (setq	lst_temp (vlax-safearray->list
		   (vlax-variant-value (vla-GetAttributes BlkRef))
		 )
  )
  (foreach item	lst_temp
    (if	(= (vla-get-TagString item) "ПОЗИЦИЯ")
      (setq att_pos (vla-get-TextString item))
    )
  )
  (setq
    lst_temp
     (vlax-safearray->list
       (vlax-variant-value (vla-GetDynamicBlockProperties BlkRef))
     )
  )
  (foreach item	lst_temp
    (if	(= (vla-get-PropertyName item) "Наименование")
      (setq naimenov (vlax-variant-value (vla-get-Value item)))
    )
  )

  (vlax-for item M-vla_ModelSpace
    (if	(= (vla-get-ObjectName item) "AcDbBlockReference") ;if1
      (if (= (vla-get-IsDynamicBlock item) :vlax-true) ;if2
	(progn				;progn1
	  (foreach item2
		   (vlax-safearray->list
		     (vlax-variant-value (vla-GetDynamicBlockProperties item))
		   )
	    (if	(= (vla-get-PropertyName item2) "Наименование")
	      (setq flag t)
	    )
	  )
	  (if flag			;if3
	    (progn			;progn2
	      (setq			;setq1
		lst_temp
		 (vlax-safearray->list
		   (vlax-variant-value (vla-GetDynamicBlockProperties item))
		 )
	      )				;setq1
	      (foreach item1 lst_temp
		(if (= (vla-get-PropertyName item1) "Наименование")
		  (setq naimenov1 (vlax-variant-value (vla-get-Value item1)))
		)
	      )
	      (if (= naimenov1 naimenov)
		(setq lst (append lst (list item)))
	      )
	      (setq flag nil)
	    )				;progn2
	  )				;if3
	)				;progn1
      )					;if2
    )					;if1
  )					;vlax-for
  (foreach item	lst
    (setq lst_temp (vlax-safearray->list
		     (vlax-variant-value (vla-GetAttributes item))
		   )
    )
    (foreach item1 lst_temp
      (if (= (vla-get-TagString item1) "ПОЗИЦИЯ")
	(vla-put-TextString item1 att_pos)
      )
    )
  )
  (princ)
)
Makswell вне форума  
 
Непрочитано 27.11.2008, 10:21
#5
Supermax

Руководитель фирмы
 
Регистрация: 28.03.2007
Москва
Сообщений: 1,831
Отправить сообщение для Supermax с помощью Skype™


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

Один - маркирует элементы (3D динамические блоки, трубы ППУ). Точнее он делает сразу много вещей. Ставит на плане трассы в место, которое указываешь кружок с номером элемента в центре. Прописывает этот номер в атрибут "Номер элемента", записывает в текстовый файл этот номер, наименование элемента и длинну трубы (трубы ППУ должны быть заказаны с нужной длинной) для дальнейшего перекочевывания в спецификацию и раскрой труб.

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

А что тебе надо, не пойму.
Supermax вне форума  
 
Автор темы   Непрочитано 27.11.2008, 10:36
#6
gizmo_zx

Проектировщик ЭО,ЭМ, ЭОС
 
Регистрация: 18.07.2007
Нижний Новгород
Сообщений: 247
<phrase 1= Отправить сообщение для gizmo_zx с помощью Skype™


О приветствую тебя великий Supermax, повелитель "видимости и не видимости" (за это тебе отдельная благодарность)

Есть динамические блоки опор: опора1, опора2 и опора3
вних есть атрибут "num", вот его и надо пронумеровать, но логики в нумерах нет, т.е. по X или по Y нумеровать не получиться, появилясь идея нумеровать их щелкая на блоке и чтоб в атрибут "num" записывался
префикс + номер+ суффикс (заданные при старте программы).
Т.Е. запустил программу указал ее префикс, стартовы номер,суффикс, и потыкал блоки мышкой
gizmo_zx вне форума  
 
Непрочитано 27.11.2008, 10:44
#7
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


В блоке опора1 должны быть одинаковые значения атрибута num? Я правильно понял?
Makswell вне форума  
 
Автор темы   Непрочитано 27.11.2008, 10:49
#8
gizmo_zx

Проектировщик ЭО,ЭМ, ЭОС
 
Регистрация: 18.07.2007
Нижний Новгород
Сообщений: 247
<phrase 1= Отправить сообщение для gizmo_zx с помощью Skype™


Цитата:
Сообщение от Makswell Посмотреть сообщение
В блоке опора1 должны быть одинаковые значения атрибута num? Я правильно понял?
нумерация должна быть сквозная через все блоки:

опора1 (num =1) , опора2 (num =2), опора1 (num =3),опора3 (num =4) ...
gizmo_zx вне форума  
 
Непрочитано 27.11.2008, 10:54
#9
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,654


Вот небольшой dvb (в смысле, прикреплен). Форма немодальная, так что для изменения значений текстовых полей надо ткнуть в соответствующий фрейм (т.е. суффикс - в поле "суффикс" и т.д.). Кнопка "А" предлагает выбрать блок и все наименования атрибутов запихивает в соответствующий список. Ну и по кнопке ">" выбираем последовательно блоки, и атрибут с заданным именем (если он есть) меняет значение. После этого текстбокс "значение" увеличивается на 1.
Миниатюры
Нажмите на изображение для увеличения
Название: 1.JPG
Просмотров: 180
Размер:	9.7 Кб
ID:	12745  
Вложения
Тип файла: dvb Atr.dvb (48.0 Кб, 131 просмотров)
AlexV вне форума  
 
Автор темы   Непрочитано 27.11.2008, 11:10
#10
gizmo_zx

Проектировщик ЭО,ЭМ, ЭОС
 
Регистрация: 18.07.2007
Нижний Новгород
Сообщений: 247
<phrase 1= Отправить сообщение для gizmo_zx с помощью Skype™


Цитата:
Сообщение от AlexV Посмотреть сообщение
Вот небольшой dvb (в смысле, прикреплен). Форма немодальная, так что для изменения значений текстовых полей надо ткнуть в соответствующий фрейм (т.е. суффикс - в поле "суффикс" и т.д.). Кнопка "А" предлагает выбрать блок и все наименования атрибутов запихивает в соответствующий список. Ну и по кнопке ">" выбираем последовательно блоки, и атрибут с заданным именем (если он есть) меняет значение. После этого текстбокс "значение" увеличивается на 1.
можно еще один вопросик,
как кнопочку на это чудо сделать?
и как определенному полю присвоить значение по умолчанию
gizmo_zx вне форума  
 
Непрочитано 27.11.2008, 11:16
#11
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,654


В данной процедуре добавить:
Код:
[Выделить все]
Private Sub UserForm_Initialize()
TextBox3.Value = 1'Значение
TextBox1.Value = "Префикс"
TextBox2.Value = "Суффикс"
End Sub
Макрос на кнопку:
Код:
[Выделить все]
^C^C-vbarun Atr.dvb!Module1.main
Dvb-файл должен лежать в папке, путь к которой прописан в настройках автокада.
AlexV вне форума  
 
Автор темы   Непрочитано 27.11.2008, 11:28
#12
gizmo_zx

Проектировщик ЭО,ЭМ, ЭОС
 
Регистрация: 18.07.2007
Нижний Новгород
Сообщений: 247
<phrase 1= Отправить сообщение для gizmo_zx с помощью Skype™


Назрело еще немного вопросо создать цикл *** и выход из него

Код:
[Выделить все]
Private Sub CommandButton1_Click()
On Error Resume Next
Dim objBlk As Object, objAtr
Dim varPoint As Variant
Dim strPrompt As String
Dim i As Integer

'***
' создать цикл до нажатия (эскейп например)
'For i = 1 To 5

strPrompt = "Âûáåðèòå áëîê..."
ThisDrawing.Utility.GetEntity objBlk, varPoint, strPrompt
If TypeOf objBlk Is AcadBlockReference Then
   For Each objAtr In objBlk.GetAttributes
     If objAtr.TagString = ComboBox1.Value Then
      objAtr.TextString = TextBox1.Value & TextBox3.Value & TextBox2.Value
      TextBox3.Value = Val(TextBox3.Value) + 1
     End If
   Next
End If

'Next i

End Sub
gizmo_zx вне форума  
 
Непрочитано 27.11.2008, 11:47
#13
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,654


Тогда так:
Код:
[Выделить все]
Private Sub CommandButton1_Click()
On Error GoTo err_ch
Dim objBlk As Object, objAtr
Dim varPoint As Variant
Dim strPrompt As String
Do
strPrompt = "Выберите блок. Значение атрибута: " & TextBox1.Value & TextBox3.Value & TextBox2.Value
ThisDrawing.Utility.GetEntity objBlk, varPoint, strPrompt
If TypeOf objBlk Is AcadBlockReference Then
   For Each objAtr In objBlk.GetAttributes
     If objAtr.TagString = ComboBox1.Value Then
      objAtr.TextString = TextBox1.Value & TextBox3.Value & TextBox2.Value
      TextBox3.Value = Val(TextBox3.Value) + 1
     End If
   Next
End If
Loop
err_ch:
Err.Clear
End Sub
AlexV вне форума  
 
Непрочитано 27.11.2008, 15:27
#14
VVA

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


gizmo_zx, Это называется нумераторы
Смотри здесь, выбор большой
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 02.04.2009, 11:44
#15
rzinnurov


 
Регистрация: 07.06.2008
Сообщений: 198


Цитата:
Сообщение от Makswell Посмотреть сообщение
Вот код, которым я пользуюсь:
Код:
[Выделить все]
(defun C:M_Rewrite_pos
		       (/	      M-vla_Document
			M-vla_ModelSpace	    BlkRef	  b_name
			lst_temp      naimenov	    lst		  flag
		       )
  (vl-load-com)
  (setq M-vla_Document (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq M-vla_ModelSpace (vla-get-ModelSpace M-vla_Document))
  (setq BlkRef (vlax-ename->vla-object (car (entsel "Выбери блок:"))))
  (setq b_name (vla-get-EffectiveName BlkRef))
  (setq	lst_temp (vlax-safearray->list
		   (vlax-variant-value (vla-GetAttributes BlkRef))
		 )
  )
  (foreach item	lst_temp
    (if	(= (vla-get-TagString item) "ПОЗИЦИЯ")
      (setq att_pos (vla-get-TextString item))
    )
  )
  (setq
    lst_temp
     (vlax-safearray->list
       (vlax-variant-value (vla-GetDynamicBlockProperties BlkRef))
     )
  )
  (foreach item	lst_temp
    (if	(= (vla-get-PropertyName item) "Наименование")
      (setq naimenov (vlax-variant-value (vla-get-Value item)))
    )
  )

  (vlax-for item M-vla_ModelSpace
    (if	(= (vla-get-ObjectName item) "AcDbBlockReference") ;if1
      (if (= (vla-get-IsDynamicBlock item) :vlax-true) ;if2
	(progn				;progn1
	  (foreach item2
		   (vlax-safearray->list
		     (vlax-variant-value (vla-GetDynamicBlockProperties item))
		   )
	    (if	(= (vla-get-PropertyName item2) "Наименование")
	      (setq flag t)
	    )
	  )
	  (if flag			;if3
	    (progn			;progn2
	      (setq			;setq1
		lst_temp
		 (vlax-safearray->list
		   (vlax-variant-value (vla-GetDynamicBlockProperties item))
		 )
	      )				;setq1
	      (foreach item1 lst_temp
		(if (= (vla-get-PropertyName item1) "Наименование")
		  (setq naimenov1 (vlax-variant-value (vla-get-Value item1)))
		)
	      )
	      (if (= naimenov1 naimenov)
		(setq lst (append lst (list item)))
	      )
	      (setq flag nil)
	    )				;progn2
	  )				;if3
	)				;progn1
      )					;if2
    )					;if1
  )					;vlax-for
  (foreach item	lst
    (setq lst_temp (vlax-safearray->list
		     (vlax-variant-value (vla-GetAttributes item))
		   )
    )
    (foreach item1 lst_temp
      (if (= (vla-get-TagString item1) "ПОЗИЦИЯ")
	(vla-put-TextString item1 att_pos)
      )
    )
  )
  (princ)
)
при запуски команды выдается запрос на выбор блока, выбираю блок, а дальше ошибка: "Ошибка: ActiveX Server возвратил ошибку: Неверный индекс"
rzinnurov вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Нумерация дин.блоков "тыкая" мышью

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

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