Mark Thomas
18th Jan 2005, 02:01 pm
(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)
)
)
)
; 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)
)
)
)