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

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

структурированный список

Ответ
Поиск в этой теме
Непрочитано 10.09.2007, 10:44 #1
структурированный список
Holon
 
CNC
 
Israel
Регистрация: 07.07.2007
Сообщений: 302

Помогите преобразовать
Код:
[Выделить все]
("9001 2" "9002 4" "9003 7" "9004 8" "9005 0")
в структурированный список

Код:
[Выделить все]
((9001 2) (9002 4) (9003 7) (9004 8) (9005 0))
Просмотров: 13374
 
Непрочитано 10.09.2007, 10:56
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Код:
[Выделить все]
(defun _kpblc-string-parser (string separator /  i)
                            ;|
*    Функция разбора строки. Возвращает список либо точечную пару.
*    Параметры вызова:
*	string		разбираемая строка
*	separator	символ, используемый в качестве разделителя частей
*    Примеры вызова:
(_kpblc-string-parser "1;2;3;4;5;6" ";")	;'(1 2 3 4 5 6)
(_kpblc-string-parser "1;2" ";")		;'(1 . 2)
*    За основу взяты уроки Евгения Елпанова по рекурсиям
|;
  (cond
    ((= string "") nil)
    ((setq i (vl-string-search separator string))
     (cons (substr string 1 i)
           (_kpblc-string-parser
             (substr string (+ (strlen separator) 1 i))
             separator
             ) ;_ end of _kpblc-string-parser
           ) ;_ end of cons
     )
    (t (list string))
    ) ;_ end of cond
  ) ;_ end of defun

(mapcar '(LAMBDA(x) (mapcar 'atof (_KPBLC-STRING-PARSER x " "))) lst))
Сейчас придет VVA и покажет более короткий и красивый код
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 10.09.2007, 11:18
#3
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


Для данного, конкретного случая...
Код:
[Выделить все]
(mapcar (function (lambda (a) (read (strcat "(" a ")"))))
        '("9001 2" "9002 4" "9003 7" "9004 8" "9005 0")
) ;_  mapcar
Елпанов Евгений вне форума  
 
Автор темы   Непрочитано 10.09.2007, 11:29
#4
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Цитата:
Сообщение от Елпанов Евгений
Для данного, конкретного случая...
Код:
[Выделить все]
(mapcar (function (lambda (a) (read (strcat "(" a ")"))))
        '("9001 2" "9002 4" "9003 7" "9004 8" "9005 0")
) ;_  mapcar
Thanks
Holon вне форума  
 
Автор темы   Непрочитано 10.09.2007, 18:51
#5
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


теперь понадобилось обратное действие из списка в строку
Код:
[Выделить все]
((9001 2) (9002 4) (9003 7) (9004 8) (9005 0)) 

("9001 2" "9002 4" "9003 7" "9004 8" "9005 0")
Holon вне форума  
 
Непрочитано 10.09.2007, 19:30
#6
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


Код:
[Выделить все]
(mapcar
 (function (lambda (a) (substr a 2 (- (strlen a) 2))))
 (mapcar (function VL-PRINC-TO-STRING)
         '((9001 2) (9002 4) (9003 7) (9004 8) (9005 0))
 )
)
или то же самое, но без vl- функций
Код:
[Выделить все]
(mapcar (function (lambda (a) (strcat (itoa(car a)) " " (itoa(cadr a)))))
        '((9001 2) (9002 4) (9003 7) (9004 8) (9005 0))
)
Елпанов Евгений вне форума  
 
Автор темы   Непрочитано 10.09.2007, 22:16
#7
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Большее спасибо
Holon вне форума  
 
Автор темы   Непрочитано 10.09.2007, 23:30
#8
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


А как сделать строку без скобок
Код:
[Выделить все]
("9001 2" "9002 4" "9003 7" "9004 8" "9005 0")
вот так вот
Код:
[Выделить все]
"9001 2" "9002 4" "9003 7" "9004 8" "9005 0"
Holon вне форума  
 
Непрочитано 11.09.2007, 00:19
#9
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Это будет не одна строка, а несколько. Если же надо делать именно одну, попробуй так:
Код:
[Выделить все]
(vl-string-trim " " (apply 'strcat (mapcar '(lamdba(a) (strcat a " ")) '("9001 2" "9002 4" "9003 7" "9004 8" "9005 0"))))
Пишу без запущенного када, так что проверь скобки.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 11.09.2007, 00:49
#10
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Код:
[Выделить все]
_$ (vl-string-trim " " (apply 'strcat (mapcar '(lamdba(a) (strcat a " ")) '("9001 2" "9002 4" "9003 7" "9004 8" "9005 0"))))
; error: no function definition: A
_$
Holon вне форума  
 
Непрочитано 11.09.2007, 01:10
#11
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Код:
[Выделить все]
_$ (setq lst '("9001 2" "9002 4" "9003 7" "9004 8" "9005 0"))
("9001 2" "9002 4" "9003 7" "9004 8" "9005 0")
_$ (vl-string-trim " " (apply 'strcat (mapcar '(LAMBDA(a) (strcat a " ")) lst)))
"9001 2 9002 4 9003 7 9004 8 9005 0"
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 11.09.2007, 09:20
#12
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Есть пользовательская функция (PL:PutDat 9001 33)с двумя аргументами которая из
структурного списка по ключу (первыий аргумент функции) заменяет значение в списке на новое значение -(второий аргумент функции), список находится в фаиле: _FILE
в следуюсчем виде:
9001 3
9002 1
9003 9
9004 3
9005 2
Код:
[Выделить все]
_1_$ (PL:PutDat 9001 33)
("9001 33" "9002 1" "9003 9" "9004 3" "9005 2")
После изменения списка я немогу сохранить его в таком же виде
Код:
[Выделить все]
;;;-----------------------------------------------------------------------------------------------------
(defun LoadDat (/ basepath LoadDat)
  (setq
    basepath (strcat (substr (findfile "Glass_Project.VLX") 1 1)
		     ":\\lisp\\pl\\"
	     )
    LoadDat  (strcat basepath "LoadDat\\")
  ) ;_setq
  LoadDat
) ;_xlspath

;;;----------- (PL:LoadDat(setq _FILE (open (strcat (LoadDat) "Data_str.dat") "r"))) --------------------

(defun PL:LoadDat (_FILE / _STR)
  (if (setq _STR (read-line _FILE))
    (if	(= _STR "")
      (PL:LoadDat _FILE)
      (cons (vl-string-trim " " _STR) (PL:LoadDat _FILE))
    ) ;_ end of if 
  ) ;_ end of if 
) ;_ end of defun

;;;------------------------------------ (PL:ReMDat 9001) -------------------------------------------------

(defun PL:ReMDat (N_Ord / _STR_ReM)
  (setq	_STR_ReM
	 (mapcar (function (lambda (a) (read (strcat "(" a ")"))))
		 (PL:LoadDat
		   (setq
		     _FILE (open (strcat (LoadDat) "Data_str.dat") "r")
		   )
		 )
	 ) ;_  mapcar 
  ) ;_setq 
  (cadr (assoc N_Ord _STR_ReM))
)

;;;-------------------------------------- (PL:PutDat 9001 33) --------------------------------------------
(defun PL:PutDat (N_Ord N_str_N / _STR_ReM _par _par_n _FILE _new_string )
  (vl-load-com)
  (if (not (PL:ReMDat N_Ord))
    (progn
      (setq _FILE (open (strcat (LoadDat) "Data_str.dat") "a"))
      (write-line (strcat (itoa N_Ord) " " "1") _FILE)
      (close _FILE)
    ) ;_progn
   ) ;_if
  (setq	_STR_ReM (mapcar (function (lambda (a) (read (strcat "(" a ")"))))
			 (PL:LoadDat
			   (setq
			     _FILE (open (strcat (LoadDat) "Data_str.dat") "r")
			   )
			 )
		 ) ;_  mapcar
	_par_n	 (list N_Ord N_str_N)
	_par	 (list N_Ord (PL:ReMDat N_Ord))
	_new_string    (mapcar 
 (function (lambda (a) (substr a 2 (- (strlen a) 2)))) 
 (mapcar (function VL-PRINC-TO-STRING) 
     (subst _par_n _par _STR_ReM)
	 ))
	  ) ;_setq
  (setq _FILE (open (strcat (LoadDat) "Data_str.dat") "a"))
  (write-line
 ??????????????????????????????????????????????????????????????????????????????????????????
  ??????????????????????????????????????????????????????????????????????????????????????????
 ) 
 (close _FILE )
      );_PL:PutDat

;;;---------------------------------------------------------------------------------------------------------
Holon вне форума  
 
Непрочитано 11.09.2007, 09:43
#13
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


>Holon
Мне кажется, что вы все немного усложняете...
Правда, перед тем, как писать код, хочу уточнить - на входе у вас есть структурированный список для замены данных в файле, типа:
Код:
[Выделить все]
'("9001 33" "9002 1" "9003 9" "9004 3" "9005 2")
и есть файл, где подобного типа данные, записаны в столбик:
Код:
[Выделить все]
9001 3 
9002 1 
9003 9 
9004 3 
9005 2
Вам необходимо, изменить данные в файле, чтоб строки, имеющиеся в вашем списке, были такими же, и в файле...
Теперь несколько вопросов:
1 Я верно понял задачу?
2 Если в файле несколько раз повторяется ключ, как должна поступить программа? Заменять только первое значение или все... Кстати, возможен ли повтор ключа в вашем файле?
PS. Насколько сильно, вы привязанны к такому типу хранения информации? Как пример, можно те же самые данные хранить в базе данных, тогда все сильно упрощается (логически) - делаем выбор из базы данных по первому ключу и обновляем данные во второй колонке... Или пишем в файл данные, прямо в виде списка, т.е. со скобками, тогда из лиспа, достаточно прочесть список, сделать замену и сохранить обратно - логически проще, хотя не быстрее...
Елпанов Евгений вне форума  
 
Непрочитано 11.09.2007, 09:52
#14
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


В порядке полубреда:
Код:
[Выделить все]
(defun test (lst key value)
  (if (assoc key lst)
    (subst (list key value) (assoc key lst) lst)
    lst
    ) ;_ end of if
  ) ;_ end of defun

(defun getvalues (file-name / handle str res)
  (if (findfile file-name)
    (progn
      (setq handle (open file-name "r"))
      (while (setq str (read-line handle))
        (setq res (cons (vl-string-trim " " str) res))
        ) ;_ end of while
      (close handle)
      ) ;_ end of progn
    ) ;_ end of if
  (reverse res)
  ) ;_ end of defun

(defun savevalues (file-name lst / handle)
  (setq handle (open file-name "w"))
  (mapcar '(lambda (x)
             (write-line (vl-string-trim "()" (vl-princ-to-string x)) handle)
             ) ;_ end of lambda
          lst
          ) ;_ end of mapcar
  (close handle)
  ) ;_ end of defun
test : преобразование списка
getvalues: получение данных из файла
savevalues: сохранение данных.
Пример использования:
Код:
[Выделить все]
(setq lst (GETVALUES "c:\\datas.dat"))
("9001 3" "9002 1" "9003 9" "9004 3" "9005 2")
_$ (mapcar '(LAMBDA(x) (read (strcat "(" x ")"))) lst)
((9001 3) (9002 1) (9003 9) (9004 3) (9005 2))
_$ (test (mapcar '(LAMBDA(x) (read (strcat "(" x ")"))) lst) 9003 33)
((9001 3) (9002 1) (9003 33) (9004 3) (9005 2))
Ну а сохранение сам проверь, я не тестировал.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 11.09.2007, 09:55
#15
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Ключ повторятся недолжен, функция заменяет значение аргумента по ключу
Holon вне форума  
 
Автор темы   Непрочитано 11.09.2007, 11:22
#16
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Цитата:
Сообщение от Кулик Алексей aka kpblc
В порядке полубреда:
Код:
[Выделить все]
  (setq lst (GETVALUES "c:\\datas.dat"))
("9001 3" "9002 1" "9003 9" "9004 3" "9005 2")
_$ (mapcar '(LAMBDA(x) (read (strcat "(" x ")"))) lst)
((9001 3) (9002 1) (9003 9) (9004 3) (9005 2))
_$ (test (mapcar '(LAMBDA(x) (read (strcat "(" x ")"))) lst) 9003 33)
((9001 3) (9002 1) (9003 33) (9004 3) (9005 2))
Запись в фаил не производится обрати внимание на следующие результаты выполнения
при различных аргументах
Код:
[Выделить все]
3 forms loaded from #<editor "U:/LISP/TEST_PRG/save_values.LSP">
_$ (test (mapcar '(LAMBDA(x) (read (strcat "(" x ")"))) lst) 9003 33)
((9001 3) (9002 1) (9003 33) (9004 3) (9005 2))
_$ (test (mapcar '(LAMBDA(x) (read (strcat "(" x ")"))) lst) 9001 33)
((9001 33) (9002 1) (9003 9) (9004 3) (9005 2))
_$
Holon вне форума  
 
Непрочитано 11.09.2007, 11:37
#17
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Не понял сути вопроса. Ты задаешь разные аргументы, естественно, что результат будет разным. И вполне логичным. Кстати, savevalues кто вызывать будет?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 11.09.2007, 11:45
#18
Holon

CNC
 
Регистрация: 07.07.2007
Israel
Сообщений: 302


Я извеняюсь значения записываются это у меня с головой
Код:
[Выделить все]
_4_$ (savevalues (strcat "c:\\datas.dat") (test (mapcar '(LAMBDA(x) (read (strcat "(" x ")"))) lst) 9003 12))
nil
_4_$ (savevalues (strcat "c:\\datas.dat") (test (mapcar '(LAMBDA(x) (read (strcat "(" x ")"))) lst) 9001 1))
nil
_4_$ 


_$
Holon вне форума  
 
Непрочитано 11.09.2007, 11:50
#19
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 755


Несколько лет назад делал набор для работы с внешними текстовыми файлами, посмотри:
Код:
[Выделить все]
;;;************************************** PL:DatRead ***************************************
;;;
;;; Функция считывания форматированых текстовых файлов вида:
;;;
;;;	|-------------------------------------------------------------------------------|
;;;	|;; Начальный коментарий (необязателен)						|
;;;	|;; тестового конфигурационного файла						|
;;;	|										|
;;;	|[Settings]									|
;;;	|LineNumOff=									|
;;;	|Use Default Dir=Yes				;внутристрочный коментарий	|
;;;	|Height=-13									|
;;;	|Weight=400									|
;;;	|;; вложенный коментарий							|
;;;	|LineWeight=1.35								|
;;;	|...										|
;;;	|										|
;;;	|[Project]									|
;;;	|Orientation=1									|
;;;	|Home Dir=C:\Projects\My Project						|
;;;	|SoftwareExt=("XML" "DAT" "HLP" "INI")						|
;;;	|...										|
;;;	|-------------------------------------------------------------------------------|
;;;
;;; Формат вызова: (PL:DatRead FILENAME)
;;;
;;; FILENAME - имя файла, в случае указания пути к файлу, должна соблюдаться нотация принятая
;;;	       в AutoLisp
;;;
;;; Возвращает список вида:
;;;
;;;    (
;;;        (0 . "C:\\Temp\\Test.cfg")
;;;        (-1 "Начальный коментарий (необязателен)" "тестового конфигурационного файла")
;;;        ("Settings"
;;;            ("LineNumOff" nil)
;;;            ("Use Default Dir" "Yes" "внутристрочный коментарий")
;;;            ("Height" -13)
;;;            ("Weight" 400)
;;;            (-1 "вложенный коментарий")
;;;            ("LineWeight" 1.35)
;;;            ...
;;;        )
;;;        ("Project"
;;;            ("Orientation" 1)
;;;            ("Home Dir" "C:\\Projects\\My Project")
;;;            ("SoftwareExt" ("XML" "DAT" "HLP" "INI"))
;;;        )
;;;        ...
;;;    )
;;;
;;; где:
;;;	 (0 . "C:\\Temp\\Test.cfg") - точечная пара "ИМЯ", второй член которой имя файла
;;;	 (-1 "****" "***" ...)      - коментарии, признаком строки коментария считается
;;;				      любое количество символов ";" в начале строки
;;;	 ("SecName"
;;;	     ("Item" Value "Comment")
;;;	     ...
;;;	 )			    - списки секций данных, признаком начала внутристрочного
;;;				      коментария считается первый символ ";" в строке
;;;
;;; Данные типа: "123" "123.456" "(date1 date2 ... dateN)" и "" интерпретируются как
;;; соответствующие типы данных AutoLisp, все неинтерпретируемые данные представляются как
;;; строковые 'STR.
;;;
;;; В случае, передачи в функцию имени файла без пути, загружается первый найденный файл с
;;; совпадающим именем. Поиск проводится по текущим рабочим директориям AutoCAD'а. При
;;; неудаче поиска указанного файла, выводится предупреждающее сообщение в виде всплывающего
;;; окна и функция возвращает NIL.
;;;
(defun PL:DatRead (_FNAME / _FILE _DAT _PR1 _PR2 _PR3 _PR4)
    (if	(setq _FILE (findfile _FNAME))
	(progn
	    (setq _DAT	(cons 0 _FILE)
		  _FILE	(open _FILE "R")
	    ) ;_ end of setq
	    (setq _DAT (cons _DAT (PL:RetDat (PL:LoadDat _FILE) 0 0)))
	    (close _FILE)
	) ;_ end of progn
	(progn
	    (if	(= (getvar "SYSCODEPAGE") "ANSI_1251")
		(setq _PR1 "Файл с именем: \""
		      _PR2 "\" не найден ни в одной из следующих директорий:\n\n"
		      _PR3 "\" не найден!\n"
		      _PR4 "\nФункция прервана!\nЖаль! Очень жаль!"
		) ;_ end of setq
		(setq _PR1 "The file named: \""
		      _PR2 "\" not found in the next folders:\n\n"
		      _PR3 "\" not found!\n"
		      _PR4 "\nFunction canceled!\nSorry! Really, very sorry!"
		) ;_ end of setq
	    ) ;_ end of if
	    (alert (strcat _PR1
			   (if (= (vl-filename-directory _FNAME) "")
			       (strcat _FNAME
				       _PR2
				       (PL:String-Rep
					   (PL:String-Rep (getvar "ACADPREFIX") "//" "\\")
					   ";"
					   "\n"
				       ) ;_ end of PL:String-Rep
			       ) ;_ end of strcat
			       (strcat (PL:String-Rep _FNAME "//" "\\") _PR3)
			   ) ;_ end of if
			   _PR4
		   ) ;_ end of strcat
	    ) ;_ end of alert
	) ;_ end of progn
    ) ;_ end of if
    _DAT
) ;_ end of defun
;;;
;;;
;;;************************************** PL:RetDat ****************************************
;;;
;;; Функция преобразования данных представленных в виде списка строк считанных из
;;; форматированого файла в список списков данных. Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:RetDat LIST SEC REM)
;;;
;;; LIST - список строк
;;; SEC  - индикатор секций, должен быть = 0
;;; REM  - индикатор коментариев, должен быть = 0
;;;
(defun PL:RetDat (_LST _SEC _REM / _IT)
    (if	(setq _IT (car _LST))
	(cond
	    ((= (substr _IT 1 1) "[")
	     (if (/= _SEC 1)
		 (cons (cons (vl-string-trim "[ ]; " _IT) (PL:RetDat (cdr _LST) 1 0))
		       (PL:RetDat (cdr _LST) -1 0)
		 ) ;_ end of cons
	     ) ;_ end of if
	    )
	    ((= (substr _IT 1 1) ";")
	     (cond
		 ((= _SEC -1)
		  (PL:RetDat (cdr _LST) _SEC 0)
		 )
		 ((= _REM -1)
		  (PL:RetDat (cdr _LST) _SEC -1)
		 )
		 ((= _REM 1)
		  (cons (vl-string-trim "; " _IT) (PL:RetDat (cdr _LST) _SEC 1))
		 )
		 (t
		  (cons
		      (cons -1
			    (cons
				(vl-string-trim "; " _IT)
				(PL:RetDat (cdr _LST) 1 1)
			    ) ;_ end of cons
		      ) ;_ end of cons
		      (PL:RetDat (cdr _LST) _SEC -1)
		  ) ;_ end of cons
		 )
	     ) ;_ end of cond
	    )
	    (t
	     (cond
		 ((= _SEC -1)
		  (PL:RetDat (cdr _LST) _SEC 0)
		 )
		 ((/= _REM 1)
		  (cons	(PL:StriL (vl-string-trim " " _IT))
			(PL:RetDat (cdr _LST) _SEC 0)
		  ) ;_ end of cons
		 )
		 (t nil)
	     ) ;_ end of cond
	    )
	) ;_ end of cond
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;*************************************** PL:StriL ****************************************
;;;
;;; Функция преобразования данных представленных в виде форматированой строки считанных из
;;; форматированого файла список данных. Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:StriL STRING)
;;;
;;; STRING - форматированая строка
;;;
(defun PL:StriL	(_STR / _POS _REM _VAL)
    (if	_STR
	(progn
	    (if	(setq _POS (vl-string-position 59 _STR))
		(setq _REM (vl-string-trim " ;" (substr _STR (1+ _POS)))
		      _STR (vl-string-trim " " (substr _STR 1 _POS))
		) ;_ end of setq
	    ) ;_ end of if
	    (if	(setq _POS (vl-string-position 61 _STR))
		(setq _VAL (vl-string-trim " =" (substr _STR (1+ _POS)))
		      _STR (vl-string-trim " " (substr _STR 1 _POS))
		) ;_ end of setq
	    ) ;_ end of if
	    (cons _STR
		  (cons	(if (/= _VAL "")
			    (PL:StrMean _VAL)
			) ;_ end of if
			(if _REM
			    (list _REM)
			) ;_ end of if
		  ) ;_ end of cons
	    ) ;_ end of cons
	) ;_ end of progn
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************** PL:StrMean ***************************************
;;;
;;; Функция интерпретации данных представленных в виде строки в данные AutoLisp.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:StrMean STRING)
;;;
;;; STRING - строка данных
;;;
(defun PL:StrMean (_STR)
    (if	_STR
	(cond
	    ((or (> (vl-string-position 45 _STR) 0)
		 (> (vl-string-position 43 _STR) 0)
		 (> (PL:ChrCal _STR "+") 1)
		 (> (PL:ChrCal _STR "-") 1)
		 (> (PL:ChrCal _STR ".") 1)
	     ) ;_ end of or
	     _STR
	    )
	    ((= (vl-string-trim "-+0123456789" _STR) "")
	     (atoi _STR)
	    )
	    ((= (vl-string-trim "-+0123456789." _STR) "")
	     (atof _STR)
	    )
	    ((and (= (substr _STR 1 1) "(")
		  (= (substr _STR (strlen _STR) 1) ")")
	     ) ;_ end of and
	     (read _STR)
	    )
	    (t _STR)
	) ;_ end of cond
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************** PL:LoadDat ***************************************
;;;
;;; Функция считывания и предварительной очистки текстовых файлов в список строк.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:LoadDat FILE)
;;;
;;; FILE - дескриптор файла открытого на чтение
;;;
(defun PL:LoadDat (_FILE / _STR)
    (if	(setq _STR (read-line _FILE))
	(if (= _STR "")
	    (PL:LoadDat _FILE)
	    (cons (vl-string-trim " " _STR) (PL:LoadDat _FILE))
	) ;_ end of if
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************* PL:DatCheck ***************************************
;;;
;;; Функция проверки и консолидации списков данных считанных из форматированого файла.
;;; Производится поиск и слияние одноимённых секций.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:LoadDat DAT)
;;;
;;; DAT - данные представленные в виде структурированого списка
;;;
(defun PL:DatCheck (_DAT / _IT _ID _DATT)
    (if	(setq _IT (car _DAT))
	(progn
	    (setq _DATT	(cdr _DAT)
		  _ID	(car _IT)
	    ) ;_ end of setq
	    (cond
		((assoc 0 _DATT)
		 (cons _IT (PL:DatCheck (PL:DXF-Clr _DATT 0 nil)))
		)
		((assoc _ID _DATT)
		 (cons
		     (cons
			 _ID
			 (apply 'append (mapcar 'cdr (cons _IT (PL:DXF-Clr _DATT _ID t))))
		     ) ;_ end of cons
		     (PL:DatCheck (PL:DXF-Clr _DATT _ID nil))
		 ) ;_ end of cons
		)
		(t (cons _IT (PL:DatCheck _DATT)))
	    ) ;_ end of cond
	) ;_ end of progn
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************ PL:DatClrRem ***************************************
;;;
;;; Функция удаления всех коментариев из списков данных считанных из форматированого файла.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatClrRem DAT)
;;;
;;; DAT - данные представленные в виде структурированого списка
;;;
(defun PL:DatClrRem (_DAT)
    (cons
	(car _DAT)
	(mapcar
	    (function
		(lambda	(_N)
		    (cons (car _N)
			  (PL:DXF-Clr
			      (mapcar
				  (function
				      (lambda (_I)
					  (list (car _I) (cadr _I))
				      ) ;_ end of lambda
				  ) ;_ end of function
				  (cdr _N)
			      ) ;_ end of mapcar
			      -1
			      nil
			  ) ;_ end of PL:DXF-Clr
		    ) ;_ end of cons
		) ;_ end of lambda
	    ) ;_ end of function
	    (PL:DXF-Clr (cdr _DAT) -1 nil)
	) ;_ end of mapcar
    ) ;_ end of cons
) ;_ end of defun
;;;
;;;
;;;************************************ PL:DatClrDubl **************************************
;;;
;;; Функция удаления дублей записей из списков данных считанных из форматированого файла.
;;; В случае если часть дублей имеет значения NIL, принимается первое не NIL значение и
;;; коментарий от этого значения.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatClrDubl DAT)
;;;
;;; DAT - данные представленные в виде структурированого списка
;;;
(defun PL:DatClrDubl (_DAT / _IT _ID)
    (if	(setq _IT (car _DAT))
	(cons (if (or (= (setq _ID (car _IT)) 0) (= _ID -1))
		  _IT
		  (cons _ID (PL:DelDubl (cdr _IT)))
	      ) ;_ end of if
	      (PL:DatClrDubl (cdr _DAT))
	) ;_ end of cons
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************** PL:DelDubl ***************************************
;;;
;;; Функция удаления дублей записей из списков секций.
;;; В случае если часть дублей имеет значения NIL, принимается первое не NIL значение и
;;; коментарий от этого значения.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DelDubl SECLIST)
;;;
;;; SECLIST - данные представленные в виде структурированого списка
;;;
(defun PL:DelDubl (_SLST / _IT _SLSTT _ID _REM _VAL _VLST _TMP)
    (if	(setq _IT (car _SLST))
	(progn
	    (setq _SLSTT (cdr _SLST)
		  _ID	 (car _IT)
	    ) ;_ end of setq
	    (if	(= _ID -1)
		(cons _IT (PL:DelDubl _SLSTT))
		(if (assoc _ID _SLSTT)
		    (progn
			(setq _TMP
				 (list _ID
				       (setq _VAL (PL:FirstMean
						      (setq _VLST
							       (mapcar 'cadr
								       (setq
									   _REM	(PL:DXF-Clr _SLST _ID t)
								       ) ;_ end of setq
							       ) ;_ end of mapcar
						      ) ;_ end of setq
						  ) ;_ end of PL:FirstMean
				       ) ;_ end of setq
				       (nth (vl-position _VAL _VLST) (mapcar 'caddr _REM))
				 ) ;_ end of list
			) ;_ end of setq
			(if (not (last _TMP))
			    (setq _TMP (list (car _TMP) (cadr _TMP)))
			) ;_ end of if
			(cons
			    _TMP
			    (PL:DelDubl (PL:DXF-Clr _SLSTT _ID nil))
			) ;_ end of cons
		    ) ;_ end of progn
		    (cons _IT (PL:DelDubl _SLSTT))
		) ;_ end of if
	    ) ;_ end of if
	) ;_ end of progn
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************* PL:FirstMean **************************************
;;;
;;; Функция поиска первого не NIL значения в списке.
;;; Возвращает первое не NIL значение или NIL если такого нет.
;;;
;;; Формат вызова: (PL:FirstMean LIST)
;;;
;;; LIST - список
;;;
(defun PL:FirstMean (_LST)
    (cond
	((= (length _LST) 0) nil)
	((car _LST))
	(t (PL:FirstMean (cdr _LST)))
    ) ;_ end of cond
) ;_ end of defun
;;;
;;;
;;;************************************ PL:DatClrEmpty *************************************
;;;
;;; Функция удаления пустых секций из данных считанных из форматированого файла.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatClrEmpty DAT)
;;;
;;; DAT - данные представленные в виде структурированого списка
;;;
(defun PL:DatClrEmpty (_DAT / _SEC _ID)
    (if	(setq _SEC (car _DAT))
	(cond
	    ((or (= (setq _ID (car _SEC)) 0) (= _ID -1))
	     (cons _SEC (PL:DatClrEmpty (cdr _DAT)))
	    )
	    ((not (cadr _SEC))
	     (PL:DatClrEmpty (cdr _DAT))
	    )
	    (t (cons _SEC (PL:DatClrEmpty (cdr _DAT))))
	) ;_ end of if
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************* PL:DatClrNIL **************************************
;;;
;;; Функция удаления пустых записей из данных считанных из форматированого файла.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatClrNIL DAT)
;;;
;;; DAT - данные представленные в виде структурированого списка
;;;
(defun PL:DatClrNIL (_DAT / _IT _ID)
    (if	(setq _IT (car _DAT))
	(cons (if (or (= (setq _ID (car _IT)) 0) (= _ID -1))
		  _IT
		  (cons _ID (PL:DelNIL (cdr _IT)))
	      ) ;_ end of if
	      (PL:DatClrNIL (cdr _DAT))
	) ;_ end of cons
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************** PL:DelNIL ****************************************
;;;
;;; Функция удаления пустых записей из списков секций.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DelNIL SECLIST)
;;;
;;; SECLIST - данные представленные в виде структурированого списка
;;;
(defun PL:DelNIL (_SLST / _IT)
    (if	(setq _IT (car _SLST))
	(if (not (cadr _IT))
	    (PL:DelNIL (cdr _SLST))
	    (cons _IT (PL:DelNIL (cdr _SLST)))
	) ;_ end of if
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************* PL:DatClrAll **************************************
;;;
;;; Функция проверки и очистки данных считанных из форматированого файла от пустых значений.
;;; Производится консолидация одноимённых секций, удаление всех пустых значений и удаление
;;; пустых секций. Удаление коментариев производится при не NIL значении ключа: DELREM.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatClrAll DAT DELREM)
;;;
;;; DAT    - данные представленные в виде структурированого списка
;;; DELREM - ключ удаления коментариев T - удалять все коментарии, NIL - нет
;;;
(defun PL:DatClrAll (_DAT _DREM)
    (PL:DatClrEmpty
	(PL:DatClrNIL
	    (PL:DatCheckAll
		(if _DREM
		    (PL:DatClrRem _DAT)
		    _DAT
		) ;_ end of if
	    ) ;_ end of PL:DatCheckAll
	) ;_ end of PL:DatClrNIL
    ) ;_ end of PL:DatClrEmpty
) ;_ end of defun
;;;
;;;
;;;************************************* PL:DatGetVal **************************************
;;;
;;; Функция получения значения из списков данных считанных из форматированого файла.
;;; Возвращает считанное значение.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatGetVal DAT SECTION ITEM)
;;;
;;; DAT     - данные представленные в виде структурированого списка
;;; SECTION - имя секции
;;; ITEM    - имя записи
;;;
(defun PL:DatGetVal (_DAT _SEC _IT)
    (cadr (assoc _IT (cdr (assoc _SEC _DAT))))
) ;_ end of defun
;;;
;;;
;;;*********************************** PL:DatGetSecNames ***********************************
;;;
;;; Функция получения имён всех секций в структурированном списке кроме "имён": 0 и -1.
;;; Возвращает список имён секций.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatGetSecNames DAT)
;;;
;;; DAT - данные представленные в виде структурированого списка
;;;
(defun PL:DatGetSecNames (_DAT / _IT _ID)
    (if	(setq _IT (car _DAT))
	(if (or (= (setq _ID (car _IT)) 0) (= _ID -1))
	    (PL:DatGetSecNames (cdr _DAT))
	    (cons _ID (PL:DatGetSecNames (cdr _DAT)))
	) ;_ end of if
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;********************************** PL:DatGetItemNames ***********************************
;;;
;;; Функция получения имён записей в секции в структурированном списке кроме "имён": 0 и -1.
;;; Возвращает список имён записей.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatGetSecNames DAT SECTION)
;;;
;;; DAT     - данные представленные в виде структурированого списка
;;; SECTION - имя секции
;;;
(defun PL:DatGetItemNames (_DAT _SEC)
    (PL:DatGetSecNames (cdr (assoc _SEC _DAT)))
) ;_ end of defun
;;;
;;;
;;;************************************ PL:DatCheckAll *************************************
;;;
;;; Функция проверки и консолидации секций и удаления дублей из списков данных считанных из
;;; форматированого файла.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatCheckAll DAT)
;;;
;;; DAT - данные представленные в виде структурированого списка
;;;
(defun PL:DatCheckAll (_DAT)
    (PL:DatClrDubl (PL:DatCheck _DAT))
) ;_ end of defun
;;;
;;;
;;;************************************* PL:DatPutVal **************************************
;;;
;;; Функция присвоения значения в запись списка данных считанных из форматированого файла.
;;; Если записи или секции с указанным именем не существует, то они создаются. Если значение
;;; коментария равно NIL и присутствует коментарий в текущей записи, то он сохраняется без
;;; изменения.
;;; Возвращает изменённый список данных.
;;; Подробнее в описании функции: PL:DatRead
;;;
;;; Формат вызова: (PL:DatPutVal DAT SECTION ITEM VALUE REM)
;;;
;;; DAT     - данные представленные в виде структурированого списка
;;; SECTION - имя секции
;;; ITEM    - имя записи
;;; VALUE   - значение
;;; REM     - коментарий
;;;
(defun PL:DatPutVal (_DAT _SEC _IT _VAL _REM / _NEW _TSEC _TIT _TREM)
    (setq _NEW (if _REM
		   (list _IT _VAL _REM)
		   (list _IT _VAL)
	       ) ;_ end of if
    ) ;_ end of setq
    (if	(setq _TSEC (assoc _SEC _DAT))
	(subst (if (setq _TIT (assoc _IT (cdr _TSEC)))
		   (subst (if (and (not _REM) (setq _TREM (caddr _TIT)))
			      (append _NEW (list _TREM))
			      _NEW
			  ) ;_ end of if
			  _TIT
			  _TSEC
		   ) ;_ end of subst
		   (append _TSEC (list _NEW))
	       ) ;_ end of if
	       _TSEC
	       _DAT
	) ;_ end of subst
	(append _DAT (list (list _SEC _NEW)))
    ) ;_ end of if
) ;_ end of defun
;;;
;;;
;;;************************************** PL:DatWrite **************************************
;;;
;;; Функция записи структурированых данных в форматированый текстовый файл.
;;; Подробнее в описании функции: PL:DatRead
;;; Формат вызова: (PL:DatWrite DAT FILENAME)
;;;
;;; DAT      - данные представленные в виде структурированого списка
;;; FILENAME - имя файла, в случае указания пути к файлу, должна соблюдаться нотация принятая
;;;	       в AutoLisp
;;;
;;; Возвращает T в случае успешного завершения операции записи и закрытия файла.
;;; В случае, неопределённого имени файла, в качестве имени используется имя из первой записи
;;; с кодом 0.
;;;
(defun PL:DatWrite (_DAT _FNAME / _FILE _IT _ID _TIT _TMP _VNAM _VVAL _VREM _BLN _LEN)
    (if	(setq _FILE (open (if (not _FNAME)
			      (cdr (assoc 0 _DAT))
			      _FNAME
			  ) ;_ end of if
			  "W"
		    ) ;_ end of open
	) ;_ end of setq
	(progn
	    (while (setq _IT (car _DAT))
		(setq _DAT (cdr _DAT)
		      _ID  (car _IT)
		) ;_ end of setq
		(cond
		    ((= _ID 0))
		    ((= _ID -1)
		     (while (setq _TMP (car (setq _IT (cdr _IT))))
			 (write-line (strcat ";; " _TMP) _FILE)
		     ) ;_ end of while
		    )
		    (t
		     (write-line "" _FILE)
		     (write-line (strcat "[" _ID "]") _FILE)
		     (while (setq _TIT (car (setq _IT (cdr _IT))))
			 (setq _VNAM (car _TIT))
			 (if (= _VNAM -1)
			     (while (setq _TMP (car (setq _TIT (cdr _TIT))))
				 (write-line (strcat ";; " _TMP) _FILE)
			     ) ;_ end of while
			     (progn
				 (setq _VREM (caddr _TIT)
				       _VVAL (cadr _TIT)
				       _TMP  (if (not _VVAL)
						 (strcat _VNAM "=")
						 (strcat _VNAM
							 "="
							 (if (= (type _VVAL) 'list)
							     (vl-prin1-to-string _VVAL)
							     (vl-princ-to-string _VVAL)
							 ) ;_ end of if
						 ) ;_ end of strcat
					     ) ;_ end of if
				 ) ;_ end of setq
				 (write-line
				     (if (not _VREM)
					 _TMP
					 (progn
					     (setq _BLN "")
					     (strcat
						 _TMP
						 (if (<	(setq _LEN (strlen _TMP))
							68
						     ) ;_ end of <
						     (repeat (- 68 _LEN)
							 (setq _BLN
								  (strcat _BLN " ")
							 ) ;_ end of setq
						     ) ;_ end of repeat
						     _BLN
						 ) ;_ end of if
						 " ;"
						 _VREM
					     ) ;_ end of strcat
					 ) ;_ end of progn
				     ) ;_ end of if
				     _FILE
				 ) ;_ end of write-line
			     ) ;_ end of progn
			 ) ;_ end of if
		     ) ;_ end of while
		    )
		) ;_ end of cond
	    ) ;_ end of while
	    (close _FILE)
	    t
	) ;_ end of progn
    ) ;_ end of if
) ;_ end of defun
Если при попытке использования напишет, что не хватает какихто функций - скажи.

Префиксы PL: и _PL: для имён функций я использую уже лет 10, желательно не повторять, воизбежание накладок.
Alaspher вне форума  
 
Непрочитано 11.09.2007, 11:59
#20
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Тээкс, мои варианты работы с ini-файлами - в аттаче. По-моему, ничего не забыл.
[ATTACH]1189497547.rar[/ATTACH]
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > структурированный список

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

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