Lisp modification for Average, Min, Max value

[brendon_butler2]

Can someone please assist me?
I found the below Lisp that does a great job already of calculating Average value for example, but I need to have it modified to ONLY read numeric values within selected text strings. I have values that regularly have prefixes that are not allowing the Lisp to function properly.

e.g. "H=0.60" + "B=2.75" to return "1.675"

Currently it is returning the result as "0.000".

Thanks in advance!

; Max, Min and Average by Lee McDonnell -- 12/08

(defun c:number    (/       ans         ss_max    ssl_max     xth       tent_max  ent_max   ent_base_max
        num_max   ss_min    ssl_min   yth     tent_min  ent_min   ent_base_min
        num_min   ss         ssl       index     tents       tot         ent       num
        ave
       )

   (princ "\nInitializing...")
   (initget 1 "Max Min Average")
   (setq ans (getkword "\nSpecify Numerical Requirement [MAx/MIn/Ave]: "))
   (cond
   ((= ans "Max")
    (setq ss_max    (ssget)
          ssl_max    (sslength ss_max)
          xth    0
          tent_max    0
    ) ;_  end setq
    (if (/= ssl_max 0)
        (progn
        (while    (< xth ssl_max)
            (setq ent_max (entget (ssname ss_max xth)))
            (if (= (cdr (assoc 0 ent_max)) "TEXT")
            (progn
                (setq ent_base_max (atof (cdr (assoc 1 ent_max))))
                (setq xth ssl_max)
            ) ;_  end progn
            (setq xth (1+ xth))
            ) ;_  end if
        ) ;_  end while
        (setq xth 0)
        (repeat ssl_max
            (setq ent_max (entget (ssname ss_max xth)))
            (if (= (cdr (assoc 0 ent_max)) "TEXT")
            (progn
                (setq num_max (atof (cdr (assoc 1 ent_max))))
                (if (> num_max ent_base_max)
                (setq ent_base_max num_max)
                ) ;_  end if
                (setq tent_max (1+ tent_max))
            ) ;_  end progn
            ) ;_  end if
            (setq xth (1+ xth))
        ) ;_  end repeat
        (alert (strcat "Maximum of " (rtos tent_max) " Numbers is: " (rtos ent_base_max)))
        ) ;_  end progn
        (alert "No Entities Selected.")
    ) ;_  end if
   )
   ((= ans "Min")
    (setq ss_min    (ssget)
          ssl_min    (sslength ss_min)
          yth    0
          tent_min    0
    ) ;_  end setq
    (if (/= ssl_min 0)
        (progn
        (while    (< yth ssl_min)
            (setq ent_min (entget (ssname ss_min yth)))
            (if (= (cdr (assoc 0 ent_min)) "TEXT")
            (progn
                (setq ent_base_min (atof (cdr (assoc 1 ent_min))))
                (setq yth ssl_min)
            ) ;_  end progn
            (setq yth (1+ yth))
            ) ;_  end if
        ) ;_  end while
        (setq yth 0)
        (repeat ssl_min
            (setq ent_min (entget (ssname ss_min yth)))
            (if (= (cdr (assoc 0 ent_min)) "TEXT")
            (progn
                (setq num_min (atof (cdr (assoc 1 ent_min))))
                (if (< num_min ent_base_min)
                (setq ent_base_min num_min)
                ) ;_  end if
                (setq tent_min (1+ tent_min))
            ) ;_  end progn
            ) ;_  end if
            (setq yth (1+ yth))
        ) ;_  end repeat
        (alert (strcat "Minimum of " (rtos tent_min) " Numbers is: " (rtos ent_base_min)))
        ) ;_  end progn
        (alert "No Entities Selected.")
    ) ;_  end if
   )
   ((= ans "Average")
    (setq ss    (ssget)
          ssl   (sslength ss)
          index 0
          tents 0
          tot   0
    ) ;_  end setq
    (repeat ssl
        (setq ent (entget (ssname ss index)))
        (if (= (cdr (assoc 0 ent)) "TEXT")
        (progn
            (setq num (atof (cdr (assoc 1 ent))))
            (setq tot (+ num tot))
            (setq tents (1+ tents))
        ) ;_  end progn
        ) ;_  end if
        (setq index (1+ index))
    ) ;_  end repeat
    (if (/= tents 0)
        (progn
        (setq ave (/ tot tents))
        (alert (strcat "Average of " (rtos tents) " Numbers is: " (rtos ave)))
        ) ;_  end progn
        (alert "No Text Entities Selected.")
    ) ;_  end if
   )
   ) ;_  end cond
   (princ)
) ;_  end defun

[paullimapa]

you can use this function which I modified from pBe here:

https://www.cadtutor.net/forum/topic/49178-remove-only-alphabetical-characters-from-string/

(defun numbers1 (str / a b)
 (setq a "")
 (repeat (strlen str)
   (if	(< 45 (ascii (setq b (substr str 1 1))) 58)
     (setq a (strcat a b))
   )
   (setq str (substr str 2))
 )
 a
)

https://www.cadtutor.net/forum/topic/49178-remove-only-alphabetical-characters-from-string/ 

Usage based on your Example:

(/ (+ (distof(numbers1 "H=0.60")) (distof(numbers1 "B=2.75"))) 2)

Returns: 

1.675

[ВeekeeCZ]

It seems like it's Lees's training code from his early days... If you like a more streamlined version returning an overview...

(vl-load-com)

(defun c:Numbers ( / LM:parsenumbers s)
  
  ;; Parse Numbers  -  Lee Mac ;; Parses a list of numerical values from a supplied string. ;; https://www.lee-mac.com/parsenumbers.html
  (defun LM:parsenumbers ( str )
    (   (lambda ( l ) (read (strcat "(" (vl-list->string
					  (mapcar '(lambda ( a b c )
						     (if (or (< 47 b 58)
							     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
							     (and (= 46 b) (< 47 a 58) (< 47 c 58))
							     )
						       b 32))
						  (cons nil l) l (append (cdr l) '(()))))
				    ")")))
      (vl-string->list str)))
  
  ; ================================================================================================

  (and (setq s (ssget '((0 . "*TEXT") (1 . "*#*"))))
       (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
       (setq s (mapcar '(lambda (e) (cond ((not (vl-catch-all-error-p (setq x (vl-catch-all-apply 'getpropertyvalue (list e "TextString"))))) x)
					  ((not (vl-catch-all-error-p (setq x (vl-catch-all-apply 'getpropertyvalue (list e "Text"))))) x)))
		       s))
       (setq s (mapcar 'LM:parsenumbers s))
       (setq s (mapcar 'car s))
       (setq s (vl-sort s '<))
       (princ (strcat (itoa (length s)) " found: " (substr (apply 'strcat (mapcar '(lambda (x) (strcat " < " (rtos x))) s)) 4)
		      "\n>> dlt " (rtos (- (apply 'max s) (apply 'min s))) " -- sum " (rtos (apply '+ s))
		      "\n>> min " (rtos (apply 'min s)) " -- avg " (rtos (/ (apply '+ s) (float (length s)))) " -- max " (rtos (apply 'max s))))
       )
  (princ)
  )

[Kent1Cooper]

The (atof) function always returns 0.0 from a string that doesn't begin with numerical content.

Stripping the non-numerical parts from a text string could be simplified if there's something consistent about them, such as always beginning with a letter and an = sign.  Is there some constant property like that?  Even just that everything up to and including an = sign should be removed, even if there's more than one character before it?  Is there ever a suffix, too, or instead?  [If there's a non-numerical suffix only, then (atof) should give the right result -- it works with the starting numerical content, and ignores the rest.]

[vladimir_michl]

Here is a generalization using RegEx (*multi*numbers* controls whether ALL numbers in given texts are extracted):

;Extract numbers from texts
; original by ВeekeeCZ at https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-modification-for-average-min-max-value/td-p/13413876
; RegEx and MLeader/Dim generalization by V.Michl, www.arkance.world - www.cadforum.cz

(vl-load-com)

(defun C:Extract-numbers ( / lst)

 ;(RegexpExec "weight=123.4kg" "^[^0-9\\-]*(-?\\d+(?:\\.\\d+)?)") --> ("123.4")
 ;(RegexpExec "is -98 per 123 pcs" "^[^0-9\\-]*(-?\\d+(?:\\.\\d+)?)") --> ("-98")
 (defun RegExpExec (string pattern / sublst lst RegExp)
  (setq RegExp (vlax-create-object "VBScript.RegExp"))
  (vlax-put-property RegExp 'Pattern pattern)
  (vlax-put-property RegExp 'Global :vlax-true)
  (vlax-for match (vlax-invoke RegExp 'Execute string)
    (setq sublst nil)
    (vl-catch-all-apply
      '(lambda ()
		(vlax-for submatch (vlax-get match 'SubMatches)
		 (if submatch
	      (setq sublst (cons submatch sublst))
		 )
		)
       )
    )
	(setq lst (cons (car sublst) lst))
  )
  (setq RegExp nil)
  (reverse lst)
 )
;(PRINT (RegExpExec "weight=123.4kg" "^[^0-9\\-]*(-?\\d+(?:\\.\\d+)?)"))
;(PRINT (RegExpExec "weight=1234kg" "^[^0-9\\-]*(-?\\d+(?:\\.\\d+)?)"))
;(PRINT (RegExpExec "weight=-1234kg" "^[^0-9\\-]*(-?\\d+(?:\\.\\d+)?)"))
;(PRINT (RegExpExec "weight=123.4kg per 89 pcs" "[^0-9\\-]*(-?\\d+(?:\\.\\d+)?)"))

;flatten list
 (defun LM:flatten ( l )
    (if (atom l)
        (list l)
        (append (LM:flatten (car l)) (if (cdr l) (LM:flatten (cdr l))))
    )
 )

  ; ================================================================================================

  (and (setq s (ssget '((0 . "*TEXT,*LEADER,DIMENSION") (-4 . "<OR")(1 . "*#*")(304 . "*#*")(-4 . "OR>"))))
       (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
       (setq s (mapcar '(lambda (e) 
						(setq o (vlax-ename->vla-object e)) ; getpropertyvalue fails
						(cond 
							((not (vl-catch-all-error-p (setq x (vl-catch-all-apply 'vlax-get-property (list o "TextOverride"))))) x)
							((not (vl-catch-all-error-p (setq x (vl-catch-all-apply 'vlax-get-property (list o "TextString"))))) x)
							((not (vl-catch-all-error-p (setq x (vl-catch-all-apply 'vlax-get-property (list o "Text"))))) x)
						))
		       s))
	   (setq s (mapcar '(lambda(e) (RegExpExec e "[^0-9\\-]*(-?\\d+(?:\\.\\d+)?)")) s))
	   (if *MULTI*NUMBERS* 
	    (setq s (mapcar '(lambda(e) (read e)) (LM:flatten s))) ; all numbers in a text
	    (setq s (mapcar '(lambda(e) (read (car e))) s)) ; just first
	   )
       (setq s (vl-sort s '<))
       (princ (strcat (itoa (length s)) " found: " (substr (apply 'strcat (mapcar '(lambda (x) (strcat " < " (rtos x))) s)) 4)
		      "\n>> delta " (rtos (- (apply 'max s) (apply 'min s))) " -- sum " (rtos (apply '+ s))
		      "\n>> min " (rtos (apply 'min s)) " -- avg " (rtos (/ (apply '+ s) (float (length s)))) " -- max " (rtos (apply 'max s))))
       )
  (princ)
)

Vladimir Michl, www.arkance.world  -  www.cadforum.cz

[john.uhden]

@brendon_butler2 ,

Try the attached...