topic Re: Lisp modification for Average, Min, Max value in Visual LISP, AutoLISP and General Customization Forum

Lisp modification for Average, Min, Max value

brendon_butler2 — Tue, 08 Apr 2025 01:48:57 GMT

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

Re: Lisp modification for Average, Min, Max value

paullimapa — Tue, 08 Apr 2025 05:59:41 GMT

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

Re: Lisp modification for Average, Min, Max value

ВeekeeCZ — Tue, 08 Apr 2025 07:42:17 GMT

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)
  )

Re: Lisp modification for Average, Min, Max value

Kent1Cooper — Tue, 08 Apr 2025 17:09:58 GMT

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.]

Re: Lisp modification for Average, Min, Max value

vladimir_michl — Fri, 11 Apr 2025 06:54:17 GMT

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

Re: Lisp modification for Average, Min, Max value

john.uhden — Thu, 10 Apr 2025 23:51:33 GMT

@brendon_butler2 ,

Try the attached...