
Registered forum members do not see this ad.
Code:(defun extract-nums (str / ; local functions is-num is-char parselst ; local variables cntr x str_lst new_lst lst_of_lst final_lst ) ;;; FUNCTION ;;; returns a list of reals from a given string ;;; function does _not_ check argument type ;;; ;;; example; given the string "one 12 two 22.3 three .55 four 2.255" ;;; the function would return (12.0 22.3 0.55 2.255) ;;; ;;; ARGUMENTS ;;; str = string ;;; ;;; USAGE ;;; (setq lst_of_reals (extract-nums "str")) ;;; ;;; PLATFORMS ;;; 2000+ ;;; ;;; AUTHOR ;;; Copyright 2004 Mark S. Thomas ;;; mark_at_theswamp.org ;;; ;;; VERSION ;;; 1.0 ;; returns T if 'n' falls between 48 and 57 ;; ascii characters 0-9 (defun is-num (n) (and (> n 47) (< n 58)) ) ;; returns T if 'n' is _not_ between 48 and 57 or 46 ;; all ascii characters other than 0-9 and '.'(dot/period) (defun is-char (n) (not (or (and (> n 47)(< n 58)) (= n 46))) ) ;; Stig Madsen ;; returns a list of lists delimited by 'delim' ;; example ;; given the list '(12 0 32 56 0 45) where '0' is the delimiter ;; (parselst 0 '(12 0 32 56 0 45)) ;; return would be ((12)(32 56)(45)) (defun parselst (delim lst / l ll) (while lst (cond ((not (eq (car lst) delim)) (setq l (cons (car lst) l)) ) ((setq ll (if l (cons (reverse l) ll) ll) l nil) ) ) (setq lst (cdr lst)) ) (reverse (if l (cons (reverse l) ll) ll)) ) ;; ================== main starts here ======================= (setq str_lst (vl-string->list str) cntr 0 ) (while (setq x (nth cntr str_lst)) (cond ((= x 46) ; <dot> (if (is-num (nth (1+ cntr) str_lst)); next n is a num (setq new_lst (cons x new_lst)) ) ) ((is-num x) (setq new_lst (cons x new_lst)) (if (is-char (nth (1+ cntr) str_lst)); next n is not a num (setq new_lst (cons 32 new_lst)) ) ) ((= x 32) ; <space> (if (is-num (nth (1+ cntr) str_lst)); next n is a num (setq new_lst (cons x new_lst)) ) ) ((= x 80) ; (if (is-num (nth (1+ cntr) str_lst)) (setq new_lst (cons 32 new_lst)) ) ) ); cond (setq cntr (1+ cntr)) ); while (if new_lst (progn (setq lst_of_lst (parselst 32 (reverse new_lst)) final_lst (mapcar 'atof (mapcar 'vl-list->string lst_of_lst)) ) ) ) ) ;; test function (defun c:e2sl (/ ent txt) (if (setq ent (car (entsel "\nSelect text: "))) (if (setq txt (cdr (assoc 1 (entget ent)))) (extract-nums txt) ) ) )
My signature goes here
Bookmarks