Nesterov Home Page

russian english

последнее обновление - 18.07.2004

Архив Nesterov Home Page

На этой странице можно найти полезную информацию для написания собственных программ

ini-edit.lsp	Функции для создания и редактирования ini-файлов в стиле Windows
;;; INI-EDIT.LSP contains functions to create and edit ;;; Windows-Style INI files, and to retrieve data from ;;; this files. ;;; ;;; INI-EDIT is freeware by ;;; Thomas Berger ;;; imago mundi CAD Systemhaus GmbH ;;; ;;; You may use and misuse this file ;;; and the included functions as you like. ;;; You may copy and distribute this file ;;; in whole or in parts freely. ;;; No warranties of course! ;;; ;;; If you like you may send me an email and tell me where ;;; you included this functions. ;;; ;;; CIS: Thomas Berger, 100326,2312 ;;; Internet: imago@compuserve.com ;;; http://ourworld.compuserve.com/homepages/imago ;;; ;;; ;;; FUNCTIONS ;;; ;;; (INI_WRITEENTRY inifile section variable value) ;;; inifile - string, a valid filename ;;; section - string, a section name ("[" and "]" brackets will be added automatically!) ;;; variable - string, a name of a variable in a INI file section ;;; value - string, the value for the variable ;;; ;;; This function creates a new or modifies an existing section entry. If the INI ;;; file does not exist it will be craeted automatically. ;;; [section] ;;; variable=value ;;; ;;; Example: ;;; (ini_writeentry "c:/test.ini" "NEWSECTION" "NEWVALUE" "100") ;;; creates a new ini file with content: ;;; [NEWSECTION] ;;; NEWVALUE=100 ;;; ;;; ;;; (INI_READENTRY inifile section variable) ;;; inifile - string, a valid filename ;;; section - string, a section name ("[" and "]" brackets will be added automatically!) ;;; variable - string, a name of an variable in a INI file section ;;; ;;; This function returns the value of an existing section entry as a string: ;;; ;;; Example: ;;; (ini_readentry "c:/test.ini" "NEWSECTION" "NEWVALUE") ;;; returns "100" ;;; ;;; ;;; (INI_READSECTION inifile section) ;;; inifile - string, a valid filename ;;; section - string, a section name ("[" and "]" brackets will be added automatically!) ;;; ;;; This function returns an assoc list with all variables and values of a complete ;;; ini file section ;;; ;;; Example: ;;; (ini_readsection "c:/test.ini" "NEWSECTION") ;;; returns (("NEWVALUE" "100") ("NEXTVALUE" "SAMPLE")) ;;; ;;; ;;; (INI_READINI inifile) ;;; inifile - string, a valid filename ;;; ;;; This function returns an assoc list of the complete ini file. ;;; ;;; Example: ;;; (ini_readini "c:/test.ini") ;;; returns (("[NEWSECTION]" ("NEWVALUE" "100") ("NEXTVALUE" "SAMPLE")) ("[NEXTSECTION]" ("INIPATH" "C:\\TEST.INI"))) ;;; ;;; ;;; (INI_INILINE line separator) ;;; line - a string as delivered by (read-line ..) ;;; separator - a string of a single char ;;; ;;; Example: ;;; (ini_iniline "NEWVALUE=100" "=") ;;; returns ("NEWVALUE" "100") (defun ini_readentry (inifile section entry ) (if (and (= 'STR (type section)) (/= "[" (substr section 1 1))) (setq section (strcat "[" section "]"))) (setq section (ini_readsection inifile section)) (cadr (assoc entry section)) ) (defun ini_writeentry (inifile section entry val / ofile ini sec) (if (not (findfile inifile)) (progn (setq ofile (open inifile "w")) (close ofile))) (if (and (= 'STR (type section)) (/= "[" (substr section 1 1))) (setq section (strcat "[" section "]"))) (if (setq ofile (findfile inifile)) (progn (setq ini (ini_readini inifile)) (cond ((setq sec (assoc section ini)) (if (assoc entry (cdr sec)) (setq sec (cons section (subst (list entry val) (assoc entry (cdr sec)) (cdr sec)))) (setq sec (cons section (reverse (cons (list entry val) (reverse (cdr sec)))))) ) (setq ini (subst sec (assoc section ini) ini)) (setq ofile (open ofile "w")) (if ofile (progn (mapcar '(lambda (x) (write-line (car x) ofile) (mapcar '(lambda (x) (write-line (strcat (car x) "=" (cadr x)) ofile) ) (cdr x) ) (write-line "" ofile) ) ini ) (close ofile) )) ) (T (setq ofile (open ofile "a")) (if ofile (progn (write-line section ofile) (write-line (strcat entry "=" val) ofile) (close ofile) ) ) ) ) ) ) ) (defun ini_readsection (inifile section / ofile line result ) (if (and (= 'STR (type section)) (/= "[" (substr section 1 1))) (setq section (strcat "[" section "]"))) (if (findfile inifile) (cdr (assoc section (ini_readini (findfile inifile)))) (alert (STRCAT inifile "\nnicht gefunden!")) ) ) (defun ini_readini (inifile / ofile line section result) (if (findfile inifile) (progn (setq ofile (open (findfile inifile) "r")) (if ofile (progn (while (and (setq line (read-line ofile)) (/= "[" (substr line 1 1)))) (while (and line (= "[" (substr line 1 1))) (setq section (list line)) (while (and (setq line (read-line ofile)) (/= "[" (substr line 1 1))) (if (and (/= ";" (substr line 1 1)) (/= "" line)) (setq section (cons (ini_iniline line "=") section)) ) ) (setq result (cons (reverse section) result)) ) (close ofile) )) ) (alert (STRCAT inifile "\nnicht gefunden!")) ) (reverse result) ) (defun ini_iniline (line sep / line str1 str2 ) (if (= 'STR (type line)) (progn (setq str1 "" str2 "") (while (and (/= "" line) (/= sep (substr line 1 1))) (setq str1 (strcat str1 (substr line 1 1)) line (substr line 2)) ) (if (= sep (substr line 1 1)) (setq str2 (substr line 2)) ) ) ) (list str1 str2) )
today.lsp	Функции для работы с текущей датой
;; CADENCE - Programmer's Toolbox March 1996 ;; Bill Kramer ;; ;; Listing 1 ;; Today creates a string with today's date ;; in it. ;; (defun Today ( / TMP) (setq TMP (rtos (getvar "CDATE") 2 0)) (strcat (substr TMP 5 2) "/" (substr TMP 7 2) "/" (substr TMP 1 4) ) ) ;; Listing 2 ;; Make_Date converts list of three numbers into ;; date format based on code type. ;; Code = 0 MM/DD/YY ;; 1 Mon. DD, YY ;; 2 Month DD, YY ;; (defun Make_Date (Date_List Code / Month_Names) (Set_Months) ;;build Month_Names list (if (and Date_List (= (length Date_List) 3) (apply 'and (mapcar 'numberp Date_list)) (<= 1 (car Date_List) 12) ;;month range (<= 1 (cadr Date_List) 31) ;;day range ) (cond ((= Code 0) (strcat (itoa (car Date_List)) "/" (itoa (cadr Date_List)) "/" (itoa (caddr Date_List)) ) ) ((= Code 1) (strcat (cadr (nth (1- (car Date_List)) Month_Names)) ". " (itoa (cadr Date_List)) ", " (itoa (caddr Date_List)) ) ) ((= Code 2) (strcat (car (nth (1- (car Date_List)) Month_Names)) " " (itoa (cadr Date_List)) ", " (itoa (caddr Date_List)) ) ) ) ;;end COND ;;else, Date_List is invalid! (prompt "\nBad date list in MAKE_DATE") ) ;;end IF test for Date_List ) ;; Establishes the values of list containing the ;; names of the months along with the standard ;; abreviations. This function can be modified ;; for local languages. ;; (defun Set_Months () (setq Month_Names '(( "January" "Jan") ( "February" "Feb") ( "March" "Mar") ( "April" "Apr") ( "May" "May") ( "June" "Jun") ( "July" "Jul") ( "August" "Aug") ( "September" "Sep") ( "October" "Oct") ( "November" "Nov") ( "December" "Dec") ) ) ) ;; Listing 3 ;; Is_A_Date check string to see if it a date ;; Checks for the following date formats: ;; ##/##/## MM/DD/YY ;; ##/##/#### MM/DD/YYYY ;; sss. ##, #### Mon. DD, YYYY ;; ssss...sss ##, #### Month DD, YYYY ;; (defun Is_A_Date (S / Month_Names TMP Mon) (Set_Months) ;;build Month_Names list (setq Month_Names ;;convert to upper case (mapcar '(lambda (TMP) (mapcar 'strcase TMP)) Month_Names) ) (cond ((wcmatch S "##/##/,##/#/,#/##/,#/#/") (numb_parse S) ) ((wcmatch S "##-##-,#-##-,##-#-,#-#-") (numb_parse (subst_str S "/" "-"))) ;; Check for short version of name in list ((member (strcase (substr S 1 3)) (mapcar 'cadr Month_Names)) (setq TMP (numb_parse (substr S 4))) (list (- 13 (length (member (strcase (substr S 1 3)) (mapcar 'cadr Month_Names)))) (car TMP) (cadr TMP) ) ) (t ;;isolate potential month name (setq Mon "") (while (and (> (strlen S) 0) (/= (substr S 1 1) " ")) (setq Mon (strcat Mon (substr S 1 1)) S (substr S 2) ) ) ;;see if in month names list (if (member (strcase Mon) (mapcar 'car Month_Names)) (setq TMP (cons (- 13 ;;relative month number (length ;;calculation (member (strcase Mon) (mapcar 'car Month_Names)))) (numb_parse S) ;;remaining is day/yr ) ) ) (if (and TMP (= (length TMP) 3) (numberp (car TMP)) (numberp (cadr TMP)) (numberp (caddr TMP)) ) TMP ;;return TMP list ) ;;else return nil if not a date str. ) ) ) ;; Listing 4 ;; Number parsing - returns list of numbers ;; parsed from the input string S. ;; Example: ;; (NUMB_PARSE "1,2.5,3.1415") returns ;; the list (1 2.5 3.1415) ;; (defun Numb_Parse (S / RET TMP CH Digs Trigs) (setq Digs '( "." "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "-") Trigs '( " " "," "/") TMP "" ) (while (> (strlen S) 0) (setq CH (substr S 1 1) S (substr S 2) ) (if (and (> (strlen TMP) 0) (member CH Trigs)) (setq RET (cons (read TMP) RET) TMP "" ) ) (if (> (strlen TMP) 0) (if (member CH Digs) (setq TMP (strcat TMP CH))) (if (member CH (cdr Digs)) (setq TMP (strcat TMP CH))) ) ) (if (> (strlen TMP) 0) (setq RET (cons (read TMP) RET)) ) (reverse RET) ) ;; Listing 5 ;; SUBST_STR substitute string ;; Changes all occurances of OLD in S with the ;; string NEW. All arguments to function are ;; strings. ;; (defun SUBST_STR (S New Old / Ret II JJ) (setq Ret "" II (strlen New) JJ (strlen Old) ) (while (> (strlen S) 0) (if (= (substr S 1 JJ) Old) (setq RET (strcat RET New) S (substr S (1+ JJ)) ) (setq RET (strcat RET (substr S 1 1)) S (substr S 2) ) ) ) RET ) ;; Listing 6 ;; Change all date strings stored as Text or ;; Attributes found in the current drawing ;; to be the current date. Operator can choose ;; date format from supported list of options. ;; (defun C:TODAY ( / SS1 SS2 Dt CNT EL TMP Tx) (setq Dt (Is_A_Date (Today)) ;;today's date str SS1 (ssget ;;regular text location "X" '((0 . "TEXT"))) SS2 (ssget ;;inserts with attributes "X" '((0 . "INSERT") (66 . 1))) CNT (if SS2 (sslength SS2) 0) ) ;;add ATTRIB entities to SS1, if any found (while (> CNT 0) (setq CNT (1- CNT) EL (entget (entnext (ssname SS2 CNT))) ) (while (= (cdr (assoc 0 EL)) "ATTRIB") (ssadd (cdr (assoc -1 EL)) SS1) (setq EL (entget (entnext (cdr (assoc -1 EL))))) ) ) (setq CNT (sslength SS1)) (prompt (strcat " " (itoa CNT) " entities found of interest." "\nDate format: <0=" (Make_Date Dt 0) "> 1=" (Make_Date Dt 1) " 2=" (Make_Date Dt 2) ": " )) (setq TMP (getint)) (if (or (null TMP) (< TMP 0) (> TMP 2)) (setq TMP 0)) (setq Dt (Make_Date Dt TMP)) ;; ;;search SS1 for date strings (while (> CNT 0) (setq CNT (1- CNT) EL (entget (ssname SS1 CNT)) Tx (cdr (assoc 1 EL)) ) (if (Is_A_Date Tx) (entmod (subst (cons 1 Dt) (assoc 1 EL) EL))) ) (if SS2 (command "_REGEN")) (princ) ) ;;- EOF
sp_kiler.lsp	Функция замены всех пробелов из строки на подчеркивания
;;; Функция замены всех пробелов из строки на подчеркивания (defun SP_KILLER (S / I) (setq I 1) (while (>= (strlen S) i) (if (= " " (substr S I 1)) (setq S (strcat (substr S 1 (1- I)) "_" (substr S (1+ I)))) (setq I (1+ I)) ) ) (setq S S) )
str_list.lsp	Функция преобразования строки в список строк по символу-разделителю
;;; Функция преобразования строки в список строк ;;; по символу-разделителю (defun Str_List (Str ; Строка SymDivider ; Разделитель строки / s1 ; Шаблон "_" s2 ; Шаблон "_" l ; Список строк i ; Индекс ) (setq l (list Str) s1 (strcat SymDivider "") s2 (strcat "*" s1) ) (while (wcmatch Str s2) (setq i 1) (while (not (wcmatch (substr Str i) s1)) (setq i (1+ i)) ) (setq l (cons (substr Str 1 (1- i)) l) Str (substr Str (1+ i)) ) ) (setq l (cdr (reverse (cons Str l)))) )
nstr_lst.lsp	Функция определения номера строки в списке
;;; Функция определения номера строки в списке ;;; S - строка. L - список строк. Результат строка (defun STR_NOM (S L / N) (setq N (1- (length L))) (while (and (/= S (nth N L)) (>= N 0)) (setq N (1- N)) ) (setq N (rtos N 2 0)) )
mmddyy.lsp	Функция определения текущей даты
;;;Функция определения текущей даты (defun ddmmyy (/ DATE) (setq DATE (getvar "CDATE")) (setq DATE (rtos DATE 2 0)) (setq DATE (strcat (substr DATE 7 2) "." (substr DATE 5 2) "." (substr DATE 3 2) ) ) )
нет пока	Это место для новых функций
Это место для новых функций

Поможем себе сами!

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

Если Вам нужна дополнительная информация по lisp обязательно изучите вот эти материалы:

1. AutoLISP FAQ
Автор: Reini Urban
http://xarch.tu-graz.ac.at/autocad/news/faq/autolisp.html

2. Руководство по AutoLISP на русском языке (Вариант 1)

3. Руководство по AutoLISP на русском языке (Вариант 2)

View Page Stats