Вывод списка в COMBOBOX

Вывод списка в COMBOBOX · 01.09.2005, 09:02

Имеется программа на VBA состоит из двух файлов attabvba.dvb (1125551049.dwg переименовать в attabvba.dvb)и ФОРМАТ_А4.dwg(1125550961.dwg переименовать в ФОРМАТ_А4.dwg).
В файле ФОРМАТ_А4.dwg имеется блок с атрибутами, эти атрибуты связаны с диологовым окном на VBA.
Так я не могу вывести список в Combobox, например для окна Разработал нужен такой: Иванов/Петров/Сидоров.
Помогите.
[ATTACH]1125550961.dwg[/ATTACH]
[ATTACH]1125551049.dwg[/ATTACH]

fixo · Регистрация: 24.03.2005

Цитата:

Сообщение от boban

Имеется программа на VBA состоит из двух файлов attabvba.dvb (1125551049.dwg переименовать в attabvba.dvb)и ФОРМАТ_А4.dwg(1125550961.dwg переименовать в ФОРМАТ_А4.dwg).
В файле ФОРМАТ_А4.dwg имеется блок с атрибутами, эти атрибуты связаны с диологовым окном на VBA.
Так я не могу вывести список в Combobox, например для окна Разработал нужен такой: Иванов/Петров/Сидоров.
Помогите.

Сначала запускаешь следующую функцию лечения блока:
Программа для глобального изменения всех тагов блока
Каждый таг заменяется на подсказку того же атрибута
Для твоего блока щна обязательна, он записан безграмотно,
не надо никогда делать блоки с одинаковыми тагами потом
будут вот такие проблемы
Кроме того, фамилия свободной строки не на месте плюс
в диалоге есть edit_box для Литера, а сам атрибут для него
не создан и все идет не в том порядке как в файле DCL
Тестировал в АвтоКАД2005

Код:

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

(defun change-tags-on-prompts (/	acsp	 adoc	  atts
			       att_info	block_info	  bname
			       cur_lst	ent	 ipt	  lst
			       new_block	 obj	  tag
			       
			      )
  (vl-load-com)
  (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
	acsp (vla-get-block
	       (vla-get-activelayout adoc)
	     )
  )
  (setq	att_info nil
	block_info nil
	lst nil
	cur_lst nil
  )	; for debug only
  (setq ent (car (entsel "\n	***	Select block to change ALL tags: ")))
  (if ent
    (progn
      (setq obj (vlax-ename->vla-object ent))
      (foreach a (vlax-invoke obj 'Getattributes)

	(setq cur_lst (cons (vla-get-textstring a) cur_lst))
      )
      (setq cur_lst (reverse cur_lst))

      (setq bname (vla-get-name obj))
      (setq ipt (vla-get-insertionpoint obj))
      (vlax-for	a (vla-item (vla-get-blocks adoc) bname)
	(if (eq (vla-get-objectname a) "AcDbAttributeDefinition")
	  (setq lst (cons a lst))
	)
      )
      (setq lst (reverse lst))
      (foreach att lst
	(setq att_info (list (vla-get-tagstring att)
			     (vla-get-promptstring att)
			     (vla-get-textstring att)
		       )
	)
	(setq block_info (cons att_info block_info))
      )
      (setq block_info (reverse block_info))
      (setq atts (vlax-invoke obj 'Getattributes))
      (foreach att lst
	(setq tag (cadar block_info))
	(vla-put-tagstring att (strcase tag))
	(setq block_info (cdr block_info))
      )

      (setq new_block (vla-insertblock acsp ipt bname 1 1 1 0))
      (setq atts (vlax-invoke new_block 'Getattributes))
      (foreach a atts
	(vla-put-textstring (car atts) (car cur_lst))
	(setq atts    (cdr atts)
	      cur_lst (cdr cur_lst)
	)
      )

      (vla-delete obj)
      (vlax-release-object obj)
    )
  )
  (princ)
)
;;;CaLL:(change-tags-on-prompts)

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

Код:

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

;;Helper functions:

(defun 	get-prompts (obj adoc / bname lst prompt_info)
  
(setq bname (vla-get-name obj))	     
(vlax-for a (vla-item (vla-get-blocks adoc) bname)
  (if (eq (vla-get-objectname a)"AcDbAttributeDefinition")
    (setq lst (cons a lst))))
(setq lst (reverse lst))
(foreach att lst
(setq prompt_info (cons (vla-get-promptstring att) prompt_info)))		 
(reverse prompt_info)
  )
;;						;;
(defun 	get-info (obj / atts att_info  lst)
(setq atts (vlax-invoke obj 'Getattributes))
(foreach att atts
  (setq att_info (list (vla-get-tagstring att)
		       (vla-get-textstring att)))
  (setq block_info (cons att_info block_info)))		 
(reverse block_info))
;;						;;
(defun get-com-info ( obj adoc / in_lst pm_lst)
      (setq pm_lst (get-prompts obj adoc)
	    in_lst (get-info obj)
	    com_info (mapcar 'cons pm_lst in_lst))
  com_info)
;;						;;

(defun head (lst num )
    (if (< 0 num)
      (cons (car lst) (head (cdr lst) (1- num)))))		 
		 
(defun run-att-dial ()
(setq fname "tmp.dcl")
(setq dcl_ex (load_dialog fname))
(new_dialog "attabvl" dcl_ex)
(setq fam_list '("Ivanoff" "Petroff" "Sidoroff"))  
(mapcar (function (lambda (x)
		      (progn
(start_list x)			
(mapcar 'add_list fam_list)
(end_list))))
(list "f1"	  "f2"     "f3"
      "f4"	 "f5"	    "f6"))
(setq drw_list '("Сборочный чертеж" "Габаритный чертеж"))
(start_list "v2")			
(mapcar 'add_list drw_list)
(end_list)   
(mapcar (function (lambda (x y)
(set_tile (vl-princ-to-string x) y)))
(list "s1"	 "s2"	    "s3"   
      "l2"	 "l3"    "l4"    "l5"
     )
(list (nth 0 val_list)
      (nth 1 val_list)
      (nth 4 val_list)
      (nth 7 val_list)
      (nth 8 val_list)
      (nth 5 val_list)
      (nth 6 val_list)
))
  
	
(action_tile
    "accept"
    (strcat
      "(progn (setq s1a (get_tile \"s1\"))"
      "(setq s2a (get_tile \"s2\"))"
      "(setq s3a (get_tile \"s3\"))"

       "(setq f1a (nth (atoi (get_tile \"f1\")) fam_list))"
      "(setq f2a (nth (atoi (get_tile \"f2\")) fam_list))"
      "(setq f3a (nth (atoi (get_tile \"f3\")) fam_list))"
      "(setq f4a (nth (atoi (get_tile \"f4\")) fam_list))"
      "(setq f5a (nth (atoi (get_tile \"f5\")) fam_list))"
      "(setq f6a (nth (atoi (get_tile \"f6\")) fam_list))"

      
      "(setq v1a (get_tile \"v1\"))"
      
      "(setq v2a (nth (atoi (get_tile \"v2\")) drw_list))"
      
      "(setq l1a (get_tile \"l1\"))"
      "(setq l2a (get_tile \"l2\"))"
      "(setq l3a (get_tile \"l3\"))"
      "(setq l4a (get_tile \"l4\"))"
      "(setq l5a (get_tile \"l5\"))"
     " (done_dialog 1))"
    )
  )

(action_tile "cancel" "(done_dialog 0)")

(setq knock (start_dialog))
(unload_dialog dcl_ex)
(done_dialog)

)

(prompt "\n	***	В командной строке набери: AT	***\n")

(defun C:at ()

  (vl-load-com)
  (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
  )
  (setq ent (car (entsel "\nВыбрать блок: ")))
  (if ent
    (progn
      (setq obj (vlax-ename->vla-object ent))
(setq atts (vlax-invoke obj 'Getattributes))
      (setq val_list
       (mapcar 'vla-get-textstring
	       (vlax-invoke obj 'Getattributes)))
    )
  )

  (run-att-dial)
  (if (= knock 1)
    (progn
      (setq get_list

	    (list    f1a   f2a	 f3a   f4a   f5a
		   f6a	 v2a   )
      )
      
      (foreach at atts

	(cond
;;;	  ((= (vla-get-tagstring at) "ПЕРВИЧНАЯ ПРИМЕНЯЕМОСТЬ")
;;;	       (vla-put-textstring at s1a)
;;;	      )
;;;	      ((= (vla-get-tagstring at) "ДЕЦИМАЛЬНЫЙ НОМЕР")
;;;	       (vla-put-textstring at s2a)
;;;	      )
;;;	      ((= (vla-get-tagstring at) "ДЕЦИМАЛЬНЫЙ НОМЕР")
;;;	       (vla-put-textstring at s3a)
;;;	      )
;;;	      ((= (vla-get-tagstring at) "ЛИТ.")
;;;	       (vla-put-textstring at l1a)
;;;	      )
;;;	      ((= (vla-get-tagstring at) "МАССА")
;;;	       (vla-put-textstring at l2a)
;;;	      )
;;;	      ((= (vla-get-tagstring at) "МАСШТАБ")
;;;	       (vla-put-textstring at l3a)
;;;	      )
;;;	      ((= (vla-get-tagstring at) "ЛИСТ")
;;;	       (vla-put-textstring at l4a)
;;;	      )
;;;	      ((= (vla-get-tagstring at) "ЛИСТОВ")
;;;	       (vla-put-textstring at l5a)
;;;	      )

	      ((= (vla-get-tagstring at) "РАЗРАБОТАЛ")
	       (vla-put-textstring at f1a)
	      )
	      ((= (vla-get-tagstring at) "ПРОВЕРИЛ")
	       (vla-put-textstring at f2a)
	      )
	      ((= (vla-get-tagstring at) "Т.КОНТРОЛЬ")
	       (vla-put-textstring at f3a)
	      )
	      ((= (vla-get-tagstring at) "СВОБОДНАЯ ГРАФА")
	       (vla-put-textstring at f4a)
	      )
	      ((= (vla-get-tagstring at) "Н.КОНТРОЛЬ")
	       (vla-put-textstring at f5a)
	      )
	      ((= (vla-get-tagstring at) "УТВЕРДИЛ")
	       (vla-put-textstring at f6a)
	      )
	      ((= (vla-get-tagstring at) "ВИД ЧЕРТЕЖА")
	       (vla-put-textstring at v2a)
	      )
	      (T nil)
	);
      )
      (vla-update obj)
    )
  )
  (vlax-release-object obj)
  (princ)
)
(prompt "\n	***	Программа загружена	***\n")
(prompt "\n	***	Пытался: Fatty The Old Horse 2005	***\n")
;;;(c:at)

На всякий случай выкладываю tmp.dcl:

Код:

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

attabvl : dialog {
label ="Заполнение штампа";
: row{
:boxed_column{
label ="Первичная применяемость";
: edit_box{
key ="s1";
width = 30;
}
}
:boxed_column{
label ="Децимальный номер";
: edit_box{
key ="s2";
width = 30;
}
: edit_box{
key ="s3";
width = 30;
}
}
}
: row{
:boxed_column{
label ="";
: popup_list{
label ="Разраб.";
//list ="Иванов\nПетров\nСидоров";
key ="f1";
is_enabled = true;
width = 15;
}
: popup_list{
label ="Пров.    ";
//list ="Иванов\nПетров\nСидоров";
key ="f2";
is_enabled = true;

width = 15;
}
: popup_list{
label ="Т.контр.";
//list ="Иванов\nПетров\nСидоров";
key ="f3";
is_enabled = true;
width = 15;
}
: popup_list{
label ="              ";
//list ="Иванов\nПетров\nСидоров";
key ="f4";
is_enabled = true;
width = 15;
}
: popup_list{
label ="Н.контр.";
//list ="Иванов\nПетров\nСидоров";
key ="f5";
is_enabled = true;
width = 15;
}
: popup_list{
label ="Утв.       ";
//list ="Иванов\nПетров\nСидоров";
key ="f6";
is_enabled = true;
width = 15;
}
}
:row{
:boxed_column{
: edit_box{
key ="v1";
width = 30;
}
: popup_list{
//list =" \nСборочный чертеж\nГабаритный чертеж";
key ="v2";
is_enabled = true;
width = 15;
}
}}
:boxed_column{
:row{
:boxed_column{label ="Лит.";
:column{
: edit_box{
key ="l1";
width = 10;
}
}}
:boxed_column{label ="Масса";
: edit_box{
key ="l2";
width = 10;}
}
:boxed_column{label ="Масштаб";
: edit_box{
key ="l3";
width = 10;}
}
}
:row{
: edit_box{
label ="Лист";
key ="l4";
width = 10;}
: edit_box{
label ="Листов";
key ="l5";
width = 10;}
}}}
ok_cancel;
}

Если уж тебе ничего не подходит ходы сюды:
http://dwg.ru/dwl/121

boban · 16.09.2005, 13:14

Прошло две недели, а ответа так и нет. Помогите.

boban · 02.10.2005, 21:36

Знатоки вы где?

Arkady · 03.10.2005, 12:49

файла VBA не нашел.
Выложи или пошли на arkady@rdvsystems.com

boban · 03.10.2005, 17:25

Мои огромные извенения, за отсутствие файла VBA исправляюсь и высылаю.
[ATTACH]1128345939.dwg[/ATTACH]
файл переименовать в attabvba.dvb

01.09.2005, 09:02		#1
Вывод списка в COMBOBOX boban Регистрация: 19.06.2004 Сообщений: 135 Имеется программа на VBA состоит из двух файлов attabvba.dvb (1125551049.dwg переименовать в attabvba.dvb)и ФОРМАТ_А4.dwg(1125550961.dwg переименовать в ФОРМАТ_А4.dwg). В файле ФОРМАТ_А4.dwg имеется блок с атрибутами, эти атрибуты связаны с диологовым окном на VBA. Так я не могу вывести список в Combobox, например для окна Разработал нужен такой: Иванов/Петров/Сидоров. Помогите. [ATTACH]1125550961.dwg[/ATTACH] [ATTACH]1125551049.dwg[/ATTACH]
Просмотров: 5018