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

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

чтение данных из файла

Ответ
Поиск в этой теме
Непрочитано 06.09.2005, 11:39 #1
чтение данных из файла
Александер
 
Регистрация: 15.06.2005
Сообщений: 184

Хочу создать свою небольшую базу данных и организовать по ней удобный поиск, как это можно сделать?
можно в принципе чтобы все элементы базы отображались в диалоговом окне, а там просто выбираем нужный и все.
т.е. нужен пример программки которая использует данные из файла *.txt
например: всего 2 области в окне и в зависимости от того что выбрано в первой области отображается соответствующий список во второй области.
Просмотров: 7880
 
Непрочитано 06.09.2005, 12:02
#2
Apelsinov

Проектировщик ВК. LISP-любитель.
 
Регистрация: 15.12.2003
Москва
Сообщений: 1,186
<phrase 1=


может и не совсем то что надо, но как пример, вот такая прога:
(сейчас все написал бы по другому, но она работает, и это главное)
Код:
[Выделить все]
;;;Apelsinov 07.10.2004
;;;colayer - программа переноса обьектов по слоям в зависимости от их цвета.
;;;Зависимость слоя от цвета можно задавать в окне диалога и в файле colayer.txt
;;;Все изменения сделанные в окне диалога сохраняются в файле colayer.txt
;;;
;;;
;;;Функция комманды c:colayer
(defun c:colayer (/ spis_file assoc_file i)
  (if (setq spis_file (COLAYER_DIAL))				 ;Запуск диалога
    (if	(setq assoc_file (findfile "colayer.txt"))		 ; Поиск файла
      (if (setq assoc_file (open assoc_file "w"))		 ; Открытие файла
	(progn
	  (foreach i (cdr spis_file)
	    (write-line						 ; Запись каждого элемента списка ассоц. в файл
	      (strcat (rtos (car i) 2 0)
		      ","
		      (cadr i)
	      ) ;_ strcat
	      assoc_file
	    ) ;_ write-line
	  ) ;_ foreach
	  (close assoc_file)					 ; Закрытие файла
	  (COLAYER_KERNEL					 ;Запуск ядра COLAYER_KERNEL
	    (cond ((setq nab (cadr (car spis_file))) nab)	 ;Если набор есть, то он в аргумент
		  ((not nab) (ssget "a"))			 ; Если набора нет, то все примитивы
	    ) ;_ cond
	    (car (car spis_file))				 ;аргумент autoname
	  )							 ;Запуск ядра COLAYER_KERNEL
	) ;_ progn
      ) ;_ if
    ) ;_ if
  ) ;_ if
  (princ)
) ;_ defun


;;;Обработка диалога colayer. Аргументов нет.
;;;Обрабатывает диалог.
;;;Возвращаемое значение - результат диалога - список ассоциаций '((A B) (цвет1 имя_слоя1)...(цветN имя_слояN))]
;;;где A - "1" (автоименование вкл) или "0" (автоименование выкл)
;;;B - набор или nil
;;;или nil - если диалог прерван по "cancel"
(defun COLAYER_DIAL (/ dcl_id spis_file	i add_spis old_edit_spis nab step num_autoname)
  (if (>= (setq dcl_id (load_dialog "colayer.dcl")) 0)		 ;Загрузка файла диалогов
    (progn

      (setq spis_file (FILE_SPIS))				 ;Получение списка ассоц. из файла
      (setq step 3
	    num_autoname
	     "0"
      ) ;_ setq
      (while (> step 2)						 ; Проверка на выход из диалога по указанию объектов
	(if (not (new_dialog "colayer" dcl_id))			 ;загрузка диалога "colayer"
	  (progn (princ "Не найден диалог \"colayer\"") (exit))
	) ;_ if
	(start_list "list_select" 2)				 ; Запуск редактирования окна выбора
	(add_list "Entire drawing")				 ; Добавление строки в окно
	(if nab
	  (add_list "Current seletion")				 ; Если выбор сделан то добавление строки о выборе
	) ;_ if
	(end_list)
	(set_tile "list_select" "1")				 ; Активация строки последней
	(action_tile
	  "select"
	  "(setq num_autoname (get_tile \"autoname\")) (done_dialog 4)"
								 ; выполняемое кнопкой выбора, завершение диалога для выбора
	) ;_ action_tile
	(set_tile "autoname" num_autoname)
	(COLAYER_SPIS_ADD_LIST spis_file)			 ; внедрение каждого из элементов списка ассоц. в список окна
	(action_tile						 ; Описание реакции кнопки  "add". Запуск диалога добавления ассоциации.
	  "add"
	  "(if	(setq add_spis (COLORA_ADD_OPEN dcl_id nil))
      (colayer_spis_add_list
	(setq spis_file (DEL_EDIT_NEW_COLAYER
	  spis_file
	  nil
	  add_spis
	))
      )
    )"
	) ;_ action_tile
	(action_tile						 ;Внесение изменения в список ассоциаций - удаление элемента
	  "del"

	  "(if	(not (eq 0 (strlen (get_tile \"list_spis\"))))
      (colayer_spis_add_list
	(setq spis_file (DEL_EDIT_NEW_COLAYER
	  spis_file
	  (atoi (get_tile \"list_spis\"))
	  nil
	))
      )
    )"

	) ;_ action_tile

	(action_tile						 ; Описание реакции кнопки  "edit". Запуск диалога добавления ассоциации.
	  "edit"
	  "(if	(not (eq 0 (strlen (get_tile \"list_spis\"))))
      (if (setq	add_spis (COLORA_ADD_OPEN
			   dcl_id
			   (nth (atoi (get_tile \"list_spis\")) spis_file)
			 )
	  )
	(colayer_spis_add_list
	  (setq spis_file (DEL_EDIT_NEW_COLAYER
	    spis_file
	    (atoi (get_tile \"list_spis\"))
	    add_spis
	  ))
	)
      )
    )"
	) ;_ action_tile
	(action_tile
	  "ok"
	  "(setq spis_file (cons (list (get_tile \"autoname\")
      (cond (( eq (get_tile \"list_select\") \"0\") nil)
            (( eq (get_tile \"list_select\") \"1\") nab)
      ))
      spis_file))
    (done_dialog)"
	) ;_ action_tile
	(action_tile "cancel" "(done_dialog)(setq spis_file nil)")
	(setq step (start_dialog))				 ;Запуск диалога
	(if (eq step 4)						 ; Если была нажата кнопка выбора, то присвоить значение выбора
	  (setq nab (ssget))
	) ;_ if

      ) ;_ while
      (unload_dialog dcl_id)					 ;Выгрузка диалога
    ) ;_ progn
    (princ "\n Не найден файл диалога colayer.dcl")
  ) ;_ if
  (eval 'spis_file)						 ;Вывод результирующего списка ассоциаций
) ;_ defun

;;;Обработка диалога colayer_add.
;;;Аргументы - [имя загруженного файла диалога][список типа '(цвет  имя_слоя)]
;;;Возвращаемое значение - результат диалога - список типа '(цвет  имя_слоя)
(defun COLORA_ADD_OPEN (dcl_id ed / L C CL str_err)
  (if (new_dialog "colayer_add" dcl_id)				 ; Загрузка диалога "colayer_add"
    (progn
      (LIST_COLORS_APELS)					 ;старт функции обработки списка цветов
      (if ed
	(progn
	  (set_tile "colors" (rtos (car ed) 2 0))		 ; Установка в поле "colors" цвета из выбранной ассоц. при редактировании
	  (set_tile "Layers" (cadr ed))				 ; Установка в поле "Layers" цвета из выбранной ассоц. при редактировании
	) ;_ progn
      ) ;_ if
      (action_tile						 ; Проверка вводимого значения на содержание гадких символов функцией PROV_STR_LAYERS
	"Layers"
	"(if (not (PROV_STR_LAYERS $value))
    (progn
      (alert
	\"К сожалению, в имени слоя используются непозволительные символы\"
      )
      (mode_tile \"Layers\" 2)
    )
  )"
      ) ;_ action_tile
      (action_tile
	"image"
	"(if (setq acad_color (ACAD_COLORDLG (atoi (get_tile \"colors\"))))
    (set_tile \"colors\" (rtos acad_color 2 0))
  )
  (colora1)"

      ) ;_ action_tile
      (action_tile "colors" "(colora1)")
      (action_tile						 ;Описание реакции кнопки  "ОК". Формирование списка ассоц.
	"ok"
	"(setq L (get_tile \"Layers\")
	  C (atoi (get_tile \"colors\"))
    )
    (if	(and C L)
      (setq CL (list C L))
    )
    (done_dialog)"
      ) ;_ action_tile
      (action_tile "cancel" "(done_dialog)")			 ; Описание реакции кнопки  "cancel"
      (COLORA1)
      (start_dialog)						 ;Запуск диалога
    ) ;_ progn
    (princ "Не найден диалог \"colayer_add\"")
  ) ;_ if
  (eval 'CL)							 ;Вывод результирующего списка ассоции
) ;_ defun

;;;LIST_COLORS_APELS Обработка поля "colors". Создание списка
;;;Аргументов нет
;;;Возвращаемого значения нет
;;;Создает список чисел от 0 до 255,
;;;ассоциирует его с названиями цветов, и помещает в поле "colors"
(defun LIST_COLORS_APELS (/ i r)
  (start_list "colors" 3)					 ; Запуск редактирования окна "colors"
  (setq i -1)
  (repeat 256
    (setq i (+ i 1))
    (if	(or (and (>= i 0) (< i 8)) (eq i 256))
      (setq r (cdr (assoc i					 ;назначение некоторым номерам цветов строковых названий
			  '((0 . "ByBlock")
			    (1 . "Red")
			    (2 . "Yellow")
			    (3 . "Green")
			    (4 . "Cyan")
			    (5 . "Blue")
			    (6 . "Magenta")
			    (7 . "White")
			    (256 . "ByLayer")
			   )
		   ) ;_ assoc
	      ) ;_ cdr
      ) ;_ setq
      (setq r (itoa i))
    ) ;_ if
    (add_list r)
  ) ;_ repeat
  (end_list)							 ; Завершение редактирования окна "colors"
) ;_ defun

;;;Обработка кнопок ADD EDIT NEW (обработка списка ассоциаций)
;;;Аргументы:
;;;[список ассоциаций '((цвет1 имя_слоя1)...(цветN имя_слояN))]
;;;[номер выбранного элемента списка]
;;;[заменяющий элемент списка]
;;;Возвращаемое значение: измененный список ассоциаций
(defun DEL_EDIT_NEW_COLAYER (spis_file n_del add / n new_spis_file)
  (setq n 0)							 ; Установка счетчика в 0
  (repeat (LENGTH spis_file)					 ; повторить по длине списка
    (setq new_spis_file						 ; Присвоить значении в соответствии с условиями
	   (cond
	     ((and n_del (not (eq n n_del)))
	      (cons (nth n spis_file) new_spis_file)
	     )
	     ((and (and add n_del) (eq n n_del))
	      (cons add new_spis_file)
	     )
	     ((and (null add) (eq n n_del))
	      new_spis_file
	     )
	   ) ;_ cond
    ) ;_ setq
    (setq n (+ n 1))
  ) ;_ repeat
  (if (null n_del)
    (setq new_spis_file (reverse (cons add spis_file)))
  ) ;_ if
  (reverse new_spis_file)
) ;_ defun

;;;Формирование списка в окне "list_spis" по данному списку ассоц
;;;аргумент - список ассоциаций
;;;возвращаемого значения нет
(defun COLAYER_SPIS_ADD_LIST (spis_file / i)
  (start_list "list_spis" 3)
  (FOREACH i spis_file
    (add_list (strcat (rtos (car i) 2 0) " - " (cadr i)))
  ) ;_ FOREACH
  (end_list)
) ;_ defun


;;;Функция проверки строки на непозволительные символы. Аргумент - проверяемая строка.
;;;Возвращаемое значение T - если символы в строке не найдены, nil - если найдены
(defun PROV_STR_LAYERS (str / str_err str_err_s)
  (setq	str_err	  "[~<>/\:?*|='\"]"
	str_err_s ""
  ) ;_ setq
  (repeat (strlen str)
    (setq str_err_s (strcat str_err_s str_err))
  ) ;_ repeat
  (if (not (vl-string-search "," str))
    (wcmatch str str_err_s)
  ) ;_ if
) ;_ defun



;;;Ядро программы. Аргументы - [набор][autoname - "0" или "1"].
;;;Все примитивы из набора с цветом не по слою,
;;;отправляет на слой соответствующий цвету примитива.
;;;Слой берется из файла ассоциаций,
;;;или , если необходимых ассоциаций в файле не найдено,
;;;имя слоя генерируется автоматически.
(defun COLAYER_KERNEL
		      (nab autoname / n	dxfcod dxfcolor	lay_name primcolor spis_lay i spis_file	A)
  (vl-load-com)
  (vla-startundomark
    (vla-get-activedocument (vlax-get-acad-object))
  )								 ; Для срабатывания UNDO - Старт
  (setq spis_file (FILE_SPIS))					 ;получение списка из файла
  (setq n 0)							 ; Установка счетчика на 0
  (if nab							 ; если есть набор
    (progn
      (repeat (SSLENGTH nab)
	(setq dxfcod (entget (ssname nab n)))			 ; список кодов примитива
	(setq dxfcolor (assoc 62 dxfcod))			 ; код группы цвета
	(if dxfcolor						 ; если нет группы, то цвет 256 - по слою, пропускаем
	  (progn
	    (setq primcolor (cdr dxfcolor)			 ; число - номер цвета
		  lay_name  nil
	    ) ;_ setq
	    (if	(eq autoname "1")
	      (setq lay_name (strcat "layer_color_" (rtos primcolor 2 0)))
	    ) ;_ if
								 ; генерация имени слоя
	    (if	spis_file					 ; Если функция FILE_SPIS возвращает что-то,
	      (if (setq A (assoc primcolor spis_file))
								 ;то если поиск в списке определение цвета положителен,
		(setq lay_name (cadr A))			 ;находим имя для цвета из списка по файлу
	      ) ;_ if
	    ) ;_ if
	    (if	lay_name
	      (progn
		(entmod						 ; присвоение примитиву нового слоя
		  (subst (cons 62 256)
			 (assoc 62 dxfcod)
			 (subst (cons 8 lay_name) (assoc 8 dxfcod) dxfcod)
		  ) ;_ subst
		) ;_ entmod

		(if (null (assoc primcolor spis_lay))
								 ;Если в списке spis_lay нет элемента с цветом,
		  (setq spis_lay (cons (list primcolor lay_name) spis_lay))
								 ;то этот элемент добавляется
		) ;_ if
	      ) ;_ progn
	    ) ;_ if
	  ) ;_ progn
	) ;_ if
	(setq n (+ n 1))					 ;счетчик + 1
      ) ;_ repeat
      (foreach i spis_lay					 ; Обрабатывается список ((цветов слоев)),
	(LAY_COLOR (cadr i) (car i))				 ; каждому слою присваивается соотв. цвет
      ) ;_ foreach
    ) ;_ progn
  ) ;_ if
  (vla-endundomark
    (vla-get-activedocument (vlax-get-acad-object))
  )								 ; Для срабатывания UNDO - Финиш
  (princ)
) ;_ defun


;;;LAY_COLOR - присвоение слою цвета/
;;;ситаксис: [имя слоя][цвет]
(defun LAY_COLOR (lay_name primcolor / layprim)
  (if (setq layprim (tblobjname "LAYER" lay_name))
								 ;нахождение имени слоя в таблице по имени
    (entmod (subst (cons 62 primcolor)				 ; переопределение слоя
		   (assoc 62 (entget layprim))
		   (entget layprim)
	    ) ;_ subst
    ) ;_ entmod
    (princ (strcat "\nСлой " lay_name " не создан."))
								 ; если слой в таблице не найден
  ) ;_ if
) ;_ defun

;;;FILE_SPIS - чтение файла ассоциаций и создание списка по файлу.
(defun FILE_SPIS (/ assoc_file str_file	shabl razd_str_file sp1	sp2 spis_str_file)
  (if (setq assoc_file (findfile "colayer.txt"))		 ; Поиск файла
    (if	(setq assoc_file (open assoc_file "r"))			 ; Открытие файла
      (progn
	(while (setq str_file (read-line assoc_file))
								 ; Пока строка не пуста
	  (if (setq shabl (wcmatch str_file "#*.*"))
								 ; Проверка строки по шаблону
	    (if
	      (setq razd_str_file (vl-string-search "," str_file 0))
								 ; Определение положения запятой
	       (if
		 (and
		   (setq sp1 (atoi (substr str_file 1 razd_str_file)))
								 ; То что до запятой - в число
		   (setq sp2 (substr str_file (+ 2 razd_str_file)))
								 ; То что после запятой
		 ) ;_ and
		  (if (PROV_STR_LAYERS sp2)
		    (setq spis_str_file
			   (cons (list sp1 sp2) spis_str_file)
								 ;создание списка и включение его в общий список
		    ) ;_ setq
		    (alert
		      (strcat "Слой"
			      sp2
			      " не прочитан из файла, в названии запрещенные символы."
		      ) ;_ strcat
		    ) ;_ alert
		  ) ;_ if
	       ) ;_ if
	    ) ;_ if
	  ) ;_ if
	) ;_ while
      ) ;_ progn
      (close assoc_file)					 ; Закрыть файл
    ) ;_ if
    (princ "\n Файл ассоциаций не найден!")			 ; Если файл не найден
  ) ;_ if
  (setq spis_str_file (reverse spis_str_file))			 ;переворот списка
) ;_ defun

;;;Работает с окном списка "colors" и кнопки отображения цвета "image".
;;;Запоняет кнопку цветом в зависимости от значения окна "colors"
;;;Аргументов нет, возвращаемого нет
(defun COLORA1 (/ col)
  (setq col (atoi (get_tile "colors")))
  (start_image "image")
  (fill_image
    1
    1
    (- (dimx_tile "image") 2)
    (- (dimy_tile "image") 2)
    col
  ) ;_ fill_image
  (end_image)
) ;_ defun
и соотв. DCL:
Код:
[Выделить все]
colayer: dialog {label = "colayer";
:column {label="Apply to:"; 
:row {
:popup_list {width=20; height=3;key="list_select";}
:button {label= "Select";is_default=true; key="select";}
}
spacer_1;
}
:column {label= "color - layer:";
:list_box {edit_width=5; key="list_spis";}
spacer_1;
:toggle {label="Autoname layers"; value="0";key="autoname";}
:row {
:button {label= " Add ";is_default=true; key="add";}
:button {label= " Edit ";is_default=true; key="edit";}
:button {label= " Del ";is_default=true; key="del";}
}
spacer_1;
}
:row {
:ok_button {label= " Apply ";is_default=true; key="ok";}
:cancel_button {is_cancel=true; key="cancel";}
}
:text {label="Apelsinov. Colayer 1.0 2004.";}
}

colayer_add: dialog {label = "colayer";
:row {
:image_button {width=4; height=2; fixed_height=true; fixed_width=true;key="image";color=9;}
:popup_list {width=12; height=10;key="colors";}
spacer_1;
:edit_box {key="Layers"; width=30; height=1; fixed_height=true;}
spacer_1;
:ok_button {label= " Add ";is_default=true; key="ok";}
:cancel_button {is_cancel=true; key="cancel";}
}
}
Сам файл colayer.txt имеет вид:

Код:
[Выделить все]
115,Слой_115
4,Голубой слой
2,Желтый_слой
1,Красный_слой
Apelsinov вне форума  
 
Непрочитано 06.09.2005, 20:11
#3
Лентяй

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


Прграмма по поиску записей в списке наличествующего оборудования. Украл не помню где. После небольшой доработки ищет все, что угодно.
LISP
Код:
[Выделить все]
;| ************************************************************
   The New Stock Programm                                      
   written by ProMoVi Programing - Modelling - Vizualisation   
   Author: Manfred Flori                                       
   Germany, near Munich                                        
                                                               
   DCL-File "StockNew.dcl"                                     
   Dialog SearchStock2                                         
   Select the Group and Enter the four KeyWords                
                                                               
   Dialog SearchResults_updObjects                             
   Displays the Results of the Search with the possibility to  
   navigate the pages with the following Buttons               
   [|< first Page] [< prev. Page] [next Page >] [last Page >]  
                                                               
   If you select a line in the Result-listBox you can select   
   an TextObject or an Insert with an Attribute and update the 
   Text.                                                       
                                                               
   **********************************************************|;

(DEFUN c:stocknew (/ dcl_id)
  (SETQ qq1 nil qq2  nil qq3  nil qq4  nil gnyn nil)
  (IF (NOT dcl_id) (SETQ dcl_id (LOAD_DIALOG "stock.dcl")))
  (IF (NOT (NEW_DIALOG "SearchStock2" dcl_id))
    (PROGN (ALERT "The Dialog \"SearchStock2\" is not found or corrupted")
      (EXIT)))
  (def_search2)
  (set_search2)
  (SETQ todo (START_DIALOG))
  (IF (= todo 2) (PROGN (searchdata) (displayresults)))
  (SETQ dcl_id (UNLOAD_DIALOG dcl_id))
  (PRIN1)
);end
;
(DEFUN def_search2 ()
  (ACTION_TILE "group" "(if $value (setq gnyn(substr (nth (atoi $value) groups) 1 1)))")
  (ACTION_TILE "kword1" "(setq qq1 (STRCAT \"*\" $value \"*\"))")
  (ACTION_TILE "kword2" "(setq qq2 (STRCAT \"*\" $value \"*\"))")
  (ACTION_TILE "kword3" "(setq qq3 (STRCAT \"*\" $value \"*\"))")
  (ACTION_TILE "kword4" "(setq qq4 (STRCAT \"*\" $value \"*\"))")
  (ACTION_TILE "search" "(done_dialog 2)")
  (ACTION_TILE "esc" "(done_dialog 0)")
);def_search2
;
(DEFUN set_search2 ()
  (SETQ groups (LIST
           "A - 01 OR 61 GROUP  (MECH. ATOMIZING, STUFFING BOX, STEAM TIP, STEAM TIPS)"
           "B - 02 OR 62 GROUP  (STEAM ATOMIZING, CONE TIP, D.G. PARTS, OIL GUN COMP.)"
           "C - 03 OR 63 GROUP  (FLARE COMP., CLIPS, STEAM NOZZLES, PILOTS, LABELS)"
           "D - 04 OR 64 GROUP  (PUMPS)"
           "E - 05 OR 65 GROUP  (BURNER & FURNACE ACCESSORIES)"
           "F - 06 OR 66 GROUP  (L.A.P. BURNER PARTS)"
           "G - 07 OR 67 GROUP  (ROTARY BURNERS)"
           "H - 08 OR 68 GROUP  (REFRACTORY BLOCKS)"
           "I - 09 TO 12 GROUP  (VALVES-NAO MFG , C-BURNERS, M.I. CABLES, THERMOCPLE)"
           "J - 31 TO 39 GROUP  (ROUGH CASTINGS)"
           "K - 90 TO 92 GROUP  (ELECTRICAL)"
           "L - 93 GROUP        (RAW MATERIAL, PIPE, PLATE, ETC.)"
           "M - 94 GROUP        (PIPE FITTINGS, NIPPLES, TEE, ELBOWS)"
           "N - 96 GROUP        (VALVES-PURCHASED, PRESSURE REGULATORS, ACF)"
           "O - 98 OR 99 GROUP  (DEMO-PILOT PARTS , MISC.)"
           "P - 01 TO 99 ALL    (FULL LIST FROM 01 - 99)"));setq
  (START_LIST "group" 3) ;Specify the name of the list box.
  (MAPCAR 'ADD_LIST groups) ;Specify the AutoLISP list.
  (END_LIST)
);set_search2
; Function SearchData
(DEFUN searchdata ()
  (IF (= gnyn "A") (SETQ snfile (OPEN "F:\\STOCK\\01-SN.NUM" "r")))
  (IF (= gnyn "B") (SETQ snfile (OPEN "F:\\STOCK\\02-SN.NUM" "r")))
  (IF (= gnyn "C") (SETQ snfile (OPEN "F:\\STOCK\\03-SN.NUM" "r")))
  (IF (= gnyn "D") (SETQ snfile (OPEN "F:\\STOCK\\04-SN.NUM" "r")))
  (IF (= gnyn "E") (SETQ snfile (OPEN "F:\\STOCK\\05-SN.NUM" "r")))
  (IF (= gnyn "F") (SETQ snfile (OPEN "F:\\STOCK\\06-SN.NUM" "r")))
  (IF (= gnyn "G") (SETQ snfile (OPEN "F:\\STOCK\\07-SN.NUM" "r")))
  (IF (= gnyn "H") (SETQ snfile (OPEN "F:\\STOCK\\08-SN.NUM" "r")))
  (IF (= gnyn "I") (SETQ snfile (OPEN "F:\\STOCK\\09-12-SN.NUM" "r")))
  (IF (= gnyn "J") (SETQ snfile (OPEN "F:\\STOCK\\31-39-SN.NUM" "r")))
  (IF (= gnyn "K") (SETQ snfile (OPEN "F:\\STOCK\\90-92-SN.NUM" "r")))
  (IF (= gnyn "L") (SETQ snfile (OPEN "F:\\STOCK\\93-SN.NUM" "r")))
  (IF (= gnyn "M") (SETQ snfile (OPEN "F:\\STOCK\\94-SN.NUM" "r")))
  (IF (= gnyn "N") (SETQ snfile (OPEN "F:\\STOCK\\96-SN.NUM" "r")))
  (IF (= gnyn "O") (SETQ snfile (OPEN "F:\\STOCK\\98-99-SN.NUM" "r")))
  (IF (= gnyn "P") (SETQ snfile (OPEN "F:\\STOCK\\STOCK.NUM" "r")))
  (SETQ lock1 0 lista (LIST) listb (LIST) listc (LIST))
  (WHILE (SETQ rlin (READ-LINE snfile))
    (TEXTPAGE)
    (PROMPT "SCANNING LIST-\n")
    (PROMPT (STRCAT "\n" rlin ""))
    (IF (AND (= lock1 0) (WCMATCH rlin qq4) (WCMATCH rlin qq1)
             (WCMATCH rlin qq2) (WCMATCH rlin qq3));and
      (SETQ lista (CONS rlin lista) lock1 1));if
    (IF (AND (= lock1 0) (WCMATCH rlin qq1) (WCMATCH rlin qq2) (WCMATCH rlin qq3));and
      (SETQ listb (CONS rlin listb) lock1 1));if
    (IF (AND (= lock1 0) (WCMATCH rlin qq2) (WCMATCH rlin qq3) (WCMATCH rlin qq4));and
      (SETQ listb (CONS rlin listb) lock1 1));if
    (IF (AND (= lock1 0) (WCMATCH rlin qq1) (WCMATCH rlin qq2) (WCMATCH rlin qq4))
      (SETQ listb (CONS rlin listb) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq1) (WCMATCH rlin qq3) (WCMATCH rlin qq4))
      (SETQ listb (CONS rlin listb) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq1) (WCMATCH rlin qq2))
      (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq1) (WCMATCH rlin qq3))
        (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq1) (WCMATCH rlin qq4))
      (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq2) (WCMATCH rlin qq3))
      (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq2) (WCMATCH rlin qq4))
      (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq3) (WCMATCH rlin qq4))
      (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq1))
      (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq2))
      (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq3))
      (SETQ listc (CONS rlin listc) lock1 1))
    (IF (AND (= lock1 0) (WCMATCH rlin qq4))
      (SETQ listc (CONS rlin listc) lock1 1))
    (SETQ lock1 0));WHILE
  (CLOSE snfile)
  (TEXTPAGE)
  (SETQ listq (APPEND (REVERSE lista) (REVERSE listb) (REVERSE listc)))
);searchdata
;
(DEFUN selobjandupdate ()
  (SETQ lockz 1)
  (IF (= pag "1") (SETQ nwtxt (NTH (- cnt1 7) listq) lockz 0))
  (IF (= pag "2") (SETQ nwtxt (NTH (- cnt1 6) listq) lockz 0))
  (IF (= pag "3") (SETQ nwtxt (NTH (- cnt1 5) listq) lockz 0))
  (IF (= pag "4") (SETQ nwtxt (NTH (- cnt1 4) listq) lockz 0)) 
  (IF (= pag "5") (SETQ nwtxt (NTH (- cnt1 3) listq) lockz 0))
  (IF (= pag "6") (SETQ nwtxt (NTH (- cnt1 2) listq) lockz 0))
  (IF (= pag "7") (SETQ nwtxt (NTH (- cnt1 1) listq) lockz 0))
  (IF (= lockz 0) (PROGN
      (SETVAR "CMDECHO" 0)
      (PROMPT "\nSELECT TEXT TO EDIT")
      (SETQ en (CAR (ENTSEL)))
      (REDRAW en 3)
      (SETQ ed (ENTGET en))
      (SETQ etyp (CDR (ASSOC 0 ed)))
      (IF (= etyp "TEXT") (SETQ el (CDR (ASSOC 1 ed))))
      (IF (= etyp "ATTDEF") (SETQ el (CDR (ASSOC 2 ed))))
      (IF (= etyp "INSERT") (SETQ el (CDR (ASSOC 1 (ENTGET (ENTNEXT en))))))
      (SETQ nt (SUBSTR nwtxt 1 21))
      (IF (= nt "") (SETQ nt el))
      (IF (= etyp "TEXT") (SETQ ed (SUBST (CONS 1 nt) (ASSOC 1 ed) ed)))
      (IF (= etyp "ATTDEF") (SETQ ed (SUBST (CONS 2 nt) (ASSOC 2 ed) ed)))
      (IF (= etyp "INSERT") (SETQ ed2 (SUBST (CONS 1 nt) (ASSOC 1 ed2) ed2)))
      (IF (= etyp "TEXT") (ENTMOD ed))
      (IF (= etyp "ATTDEF") (ENTMOD ed))
      (IF (= etyp "INSERT") (ENTMOD ed2))
      (IF (= etyp "INSERT") (ENTUPD (ENTNEXT en)))
      (REDRAW en 4)
      (REDRAW en 1)
      (SETQ pag "X")
      (PRINC));progn
  );if
);selobjandupdate
;
(DEFUN def_searchresults_updobjects ()
  (ACTION_TILE "esc" "(done_dialog 0)")
  (ACTION_TILE "selObj" "(done_dialog 2)")
  (ACTION_TILE "firstPage" "(showFirst)")
  (ACTION_TILE "prevPage" "(showPage -1)")
  (ACTION_TILE "nextPage" "(showPage 1)")
  (ACTION_TILE "lastPage" "(showLast)")
  (ACTION_TILE "results" "(selPage $value)")
  (MODE_TILE "prevPage" 1)
  (MODE_TILE "nextPage" 0)
  (MODE_TILE "selObj" 1)
)
;
(DEFUN set_searchresults_updobjects ()
  (START_LIST "results" 3)
  (SETQ cnt2 1)
  (REPEAT 7 (ADD_LIST (STRCAT (RTOS cnt2 2 0) " - " (NTH cnt1 listq)))
    (SETQ cnt2 (1+ cnt2) cnt1 (1+ cnt1)));repeat
  (END_LIST)
);
;
(DEFUN selpage (pagtxt)
  (IF pagtxt
    (PROGN (SETQ pag (itoa (1+ (ATOI pagtxt)))) (MODE_TILE "selObj" 0))
    (MODE_TILE "selObj" 1))
)
;
(DEFUN showfirst ()
  (SETQ cnt1 0)
  (set_searchresults_updobjects)
  (MODE_TILE "prevPage" 1) ; Disable Button "Prev. Page"
  (MODE_TILE "nextPage" 0) ; Enable Button "Next. Page"
)
;
(DEFUN showlast ()
  (SETQ cnt1 (1- nlst))
  (set_searchresults_updobjects)
  (MODE_TILE "prevPage" 0) ; Enable Button "Prev. Page"
  (MODE_TILE "nextPage" 1) ; Disable Button "Next. Page"
)
;
(DEFUN showpage (addpage)
  (IF (AND (= addpage -1) (> cnt1 6))
    (PROGN (SETQ cnt1 (- cnt1 7))
      (MODE_TILE "prevPage" 0) ; Enable Button "Prev. Page"
      (MODE_TILE "nextPage" 0) ; Enable Button "Next. Page"
    )
  )
  (IF (AND (= addpage 1) (< cnt1 (- nlist 8)))
    (PROGN (SETQ cnt1 (+ cnt1 7))
      (MODE_TILE "prevPage" 0) ; Enable Button "Prev. Page"
      (MODE_TILE "nextPage" 0) ; Enable Button "Next. Page"
    )
  )
  (set_searchresults_updobjects)
)
;
(DEFUN displayresults ()
  (ALERT
    "The DisplayResult-Function is not redy now\nbut I can show you the first Result-Page\nand you can browse between the Results"
  )
  (IF (NOT dcl_id) (SETQ dcl_id (LOAD_DIALOG "stock.dcl")))
  (IF (NOT (NEW_DIALOG "SearchResults_updObjects" dcl_id))
    (PROGN (ALERT
        "The Dialog \"SearchResults_updObjects\" is not found or corrupted")
      (EXIT)));if
  (SETQ nlst (LENGTH listq) cnt1 0 cnt2 1)
  (def_searchresults_updobjects)
  (set_searchresults_updobjects)
  (SETQ todo 5)
  (WHILE (< 1 todo)
    (SETQ todo (START_DIALOG))
    (IF (= todo 2) (PROGN (selobjandupdate) (def_searchresults_updobjects)
        (set_searchresults_updobjects);;; Call again the ResultDialogBox to select more Options
      )));while
  (PRIN1)
)
DCL
Код:
[Выделить все]
SearchStock : dialog {
	label			= "Search Stock";
	fixed_width   		= true;
	: boxed_radio_column {
		label		= "Select Group";
		key		= "group";
		: radio_button {
			key		= "GrpA";
			label		= "A - 01 OR 61 GROUP  (MECH. ATOMIZING, STUFFING BOX, STEAM TIP, STEAM TIPS)";
			mnemonic	= "A";
			value		= "1"; // Standardselection Group A - 01 or 61
		}
		: radio_button {
			key		= "GrpB";
			label		= "B - 02 OR 62 GROUP  (STEAM ATOMIZING, CONE TIP, D.G. PARTS, OIL GUN COMP.)";
			mnemonic	= "B";
			value		= "0";
		}
		: radio_button {
			key		= "GrpC";
			label		= "C - 03 OR 63 GROUP  (FLARE COMP., CLIPS, STEAM NOZZLES, PILOTS, LABELS)";
			mnemonic	= "C";
			value		= "0";
		}
		: radio_button {
			key		= "GrpD";
			label		= "D - 04 OR 64 GROUP  (PUMPS)";
			mnemonic	= "D";
			value		= "0";
		}
		: radio_button {
			key		= "GrpE";
			label		= "E - 05 OR 65 GROUP  (BURNER & FURNACE ACCESSORIES)";
			mnemonic	= "E";
			value		= "0";
		}
		: radio_button {
			key		= "GrpF";
			label		= "F - 06 OR 66 GROUP  (L.A.P. BURNER PARTS)";
			mnemonic	= "F";
			value		= "0";
		}
		: radio_button {
			key		= "GrpG";
			label		= "G - 07 OR 67 GROUP  (ROTARY BURNERS)";
			mnemonic	= "G";
			value		= "0";
		}
		: radio_button {
			key		= "GrpH";
			label		= "H - 08 OR 68 GROUP  (REFRACTORY BLOCKS)";
			mnemonic	= "H";
			value		= "0";
		}
		: radio_button {
			key		= "GrpI";
			label		= "I - 09 TO 12 GROUP  (VALVES-NAO MFG , C-BURNERS, M.I. CABLES, THERMOCPLE)";
			mnemonic	= "I";
			value		= "0";
		}
		: radio_button {
			key		= "GrpJ";
			label		= "J - 31 TO 39 GROUP  (ROUGH CASTINGS)";
			mnemonic	= "J";
			value		= "0";
		}
		: radio_button {
			key		= "GrpK";
			label		= "K - 90 TO 92 GROUP  (ELECTRICAL)";
			mnemonic	= "K";
			value		= "0";
		}
		: radio_button {
			key		= "GrpL";
			label		= "L - 93 GROUP        (RAW MATERIAL, PIPE, PLATE, ETC.)";
			mnemonic	= "L";
			value		= "0";
		}
		: radio_button {
			key		= "GrpM";
			label		= "M - 94 GROUP        (PIPE FITTINGS, NIPPLES, TEE, ELBOWS)";
			mnemonic	= "M";
			value		= "0";
		}
		: radio_button {
			key		= "GrpN";
			label		= "N - 96 GROUP        (VALVES-PURCHASED, PRESSURE REGULATORS, ACF)";
			mnemonic	= "N";
			value		= "0";
		}
		: radio_button {
			key		= "GrpO";
			label		= "O - 98 OR 99 GROUP  (DEMO-PILOT PARTS , MISC.)";
			mnemonic	= "O";
			value		= "0";
		}
		: radio_button {
			key		= "GrpP";
			label		= "P - 01 TO 99 ALL    (FULL LIST FROM 01 - 99)";
			mnemonic	= "P";
			value		= "0";
		}
						

	}
	: row {
		: boxed_column {
			label		= "Key-Words";
			alignment	= centered;
			fixed_width 	= true;
			: edit_box {
				key		= "kword1";
				label		= "Key-Word  #1";
				mnemonic	= "1";
				value		= "";
				edit_width	= 20;
			}
			: edit_box {
				key		= "kword2";
				label		= "Key-Word  #2";
				mnemonic	= "2";
				value		= "";
				edit_width	= 20;
			}
			: edit_box {
				key		= "kword3";
				label		= "Key-Word  #3";
				mnemonic	= "3";
				value		= "";
				edit_width	= 20;
			}
			: edit_box {
				key		= "kword4";
				label		= "Key-Word  #4";
				mnemonic	= "4";
				value		= "";
				edit_width	= 20;
			}
		}
		: column {
			: spacer { height = 2; }
			: button {
				key		= "search";
				label		= "Search";
				mnemonic	= "S";
				fixed_width	= true;
			}
			: spacer { height = 1; }
			: button {
				key		= "esc";
				label		= "Cancel";
				mnemonic	= "C";
				fixed_width	= true;
				is_cancel	= true;
			}
			: spacer { height = 2; }
		}
		: spacer { width = 15; }
	}
}

SearchStock2 : dialog {
	label			= "Search Stock";
	fixed_width   		= true;
	: boxed_column {
		: popup_list {
			key		= "group";
			label		= "Select Group";
			mnemonic	= "S";
			list		= "";
			alignment	= left;
	        	width		= 100;
		}
		: row {
			: spacer { width = 20; }
			: column {
				: text {
					label		= "Enter the Key-Words";
					alignment	= centered;
				}
				: edit_box {
					key		= "kword1";
					label		= "Key-Word  #1";
					mnemonic	= "1";
					value		= "";
					edit_width	= 20;
				}
				: edit_box {
					key		= "kword2";
					label		= "Key-Word  #2";
					mnemonic	= "2";
					value		= "";
					edit_width	= 20;
				}
				: edit_box {
					key		= "kword3";
					label		= "Key-Word  #3";
					mnemonic	= "3";
					value		= "";
					edit_width	= 20;
				}
				: edit_box {
					key		= "kword4";
					label		= "Key-Word  #4";
					mnemonic	= "4";
					value		= "";
					edit_width	= 20;
				}
			}
			: spacer { width = 40; }
		}
	}
	: row {
		alignment	= centered;
		: spacer { width = 5; }
		: button {
			key		= "search";
			label		= "Search";
			mnemonic	= "S";
			fixed_width	= true;
			alignment	= centered;
		}
		: spacer { width = 1; }
		: button {
			key		= "esc";
			label		= "Cancel";
			mnemonic	= "C";
			fixed_width	= true;
			alignment	= centered;
			is_cancel	= true;
		}
		: spacer { width = 5; }
	}
}

SearchResults_updObjects : dialog {
	label	= "Search Results and update Text-Objects";
	: row {
		: column {
			: list_box {
				label		= "Results";
				key		= "results";
				width		= 30;
				height		= 7;
			}
			: row {
				fixed_width	= true;
				alignment	= centered;
				: button {
					key		= "firstPage";
					label		= "|< first Page";
					mnemonic	= "f";
					fixed_width	= true;
				}
				: button {
					key		= "prevPage";
					label		= "< prev. Page";
					mnemonic	= "p";
					fixed_width	= true;
				}
				: button {
					key		= "nextPage";
					label		= "next Page >";
					mnemonic	= "n";
					fixed_width	= true;
				}
				: button {
					key		= "lastPage";
					label		= "last Page >|";
					mnemonic	= "l";
					fixed_width	= true;
				}
			}
		}
		: spacer { width = 5; }
		: column {
			: spacer { height = 1; }
			: button {
				key		= "selObj";
				label		= "select Object";
				mnemonic	= "O";
				width		= 15;
			}
			: spacer { height = 1; }
			: button {
				key		= "esc";
				label		= "Cancel";
				mnemonic	= "C";
				width		= 15;
				is_cancel	= true;
			}
			: spacer { height = 2; }
		}
	}
}
Лентяй вне форума  
 
Непрочитано 07.09.2005, 06:49 Re: чтение данных из файла
#4
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


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

Но стоит подумать и о перспективе. Делать таким образом для многих разнообразных задач будет себе накладно. Особенно с убогими средствами DCL.
Цитата:
... небольшую базу данных
Первое относительное понятие - "небольшая". Для кого-то 100 строк, для кого-то "небольшая" это 100000.

Цитата:
... организовать по ней удобный поиск
Тоже относительно. Выбор из списка - это не поиск. Вполне пригоден при "небольшой" базе, но быстро надоест.

Удобный поиск - когда можно задать условие или хотя бы набирая символы сразу перемещаться на нужный элемент.

Цитата:
... всего 2 области в окне и в зависимости от того что выбрано в первой области отображается соответствующий список во второй области.
Сначала всего 2, в других вариантах понадобится 9. И будет все новое конструирование диалогов.

К чему все это написано?

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

Это так, в порядке намека на возможное решение. Если "да мне только...", то можно и так. :wink:

И не надо забывать, что "база" может быть в текстовом файле прямо в виде ассоциированного LISP-списка. Хорошим примером работы с подобной "базой" является программа "Прокат" Василия Кондрата, которую можно взять где-то на сайте Геннадия (aka PG).

Хороший пример и в смысле того, что и как тщательно сделано, и в смысле того, сколько лишнего труда потрачено из-за привязки к такой технологии.
ShaggyDoc вне форума  
 
Автор темы   Непрочитано 07.09.2005, 09:45
#5
Александер


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


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

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

всем спасибо за предложения.
Александер вне форума  
 
Автор темы   Непрочитано 07.09.2005, 11:21
#6
Александер


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


<ShaggyDoc

"И не надо забывать, что "база" может быть в текстовом файле прямо в виде ассоциированного LISP-списка. Хорошим примером работы с подобной "базой" является программа "Прокат" Василия Кондрата, которую можно взять где-то на сайте Геннадия (aka PG). "

вот это как раз то что мне нужно только "Прокат" Василия Кондрата что-то не нашел, может еще где есть?
или подобный пример написания программы с использованием ассоциированного lisp-списка.
Александер вне форума  
 
Непрочитано 08.09.2005, 10:24
#7
algol2

конструктор
 
Регистрация: 23.06.2005
Украмна
Сообщений: 9


http://cadhlp.kulichki.com/prog4/prg4-1.htm#kondrat
algol2 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > чтение данных из файла

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

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