Dimsum ... Help w/ a Mod =)

[JoeyG_77]

Hey everyone I have been using this lisp forever and always wanted a function added and have no idea how to add it. Props to Tony Hotchkiss for writing this great lisp. I wanted to add the function of once it is added together that it shows the answer like it does now, BUT then asks you if you want to divide the answer and by how many times and shows that answer. Here is the lisp from Tony ....

 

;;;12345678901234567890123456789012345678901234567890
;;; DIMSUM.LSP a program to extract the sum of
;;; all selected dimension texts.
;;; Program by Tony Hotchkiss for R14.

(defun dxf (code ename)
 (cdr (assoc code (entget ename)))
) ;_ end of defun

(defun dimsum ()
 (setq ss nil)
 (prompt "\nSelect dimensions: ")
 (while (not ss)
   (setq ss (ssget '((-4 . "<OR")
                     (0 . "DIMENSION")
                     (0 . "MTEXT")
                    (-4 . "OR>"))
            ); ssget
   ); setq
   (if ss
     (progn
       (setq dims 1)
     ); progn
     (progn
       (prompt
        "\nNo dimensions selected; select again: "
       ) ;_ end of prompt
       (setq dims 0)
     ); progn
   ); if
 ) ;_ end of while
 (setq d-m-lists (categorize ss)
       mlist1  (do-dims (car d-m-lists))
       mlist2  (do-mtxt (cadr d-m-lists))
       mlist (append mlist1 mlist2)
 ); setq
 (setq n 0 txtlist nil)
 (repeat (length mlist)
   (setq mtxt (nth n mlist))
   (setq txt (mtxt-2-txt mtxt))
   (setq txtlist (append txtlist (list txt)))
   (setq n (1+ n))
 ); repeat
 (setq numlist (mapcar 'atof txtlist))
 (setq sumtotal (apply '+ numlist))
 (print (strcat "Total length of selected "
        "dimensions is: " 
        (rtos sumtotal 2 4) " or "
        (rtos sumtotal 5 4)
 )); print and strcat
 (princ)
) ;_ end of dimsum

(defun categorize (ss)
 (setq k        (- 1)
       dim-list nil
       txt-list nil
 ); setq
 (repeat (sslength ss)
   (setq ename	(ssname ss (setq k (1+ k)))
         etype (dxf 0 ename)
   ); setq
   (if (= etype "DIMENSION")
     (setq dim-list (append dim-list (list ename)))
     (setq txt-list (append txt-list (list ename)))
   ); if
 ); repeat
 (list dim-list txt-list)
); categorize

(defun do-dims (dlist)
 (setq mv-list nil)
 (repeat (length dlist)
   (setq bname   (dxf 2 (car dlist))
  blist   (tblsearch "BLOCK" bname)
         ent     (cdr (assoc -2 blist))
         got-it  nil
   ) ;_ end of setq
   (while (not got-it)
     (setq etype (dxf 0 ent))
     (if (= etype "MTEXT")
       (progn
         (setq mtxt-val (dxf 1 ent)
               got-it   T
         ); setq
       ); progn
     ); if
     (setq ent (entnext ent))
   ); while
   (setq mv-list (append mv-list (list mtxt-val))
         dlist   (cdr dlist)
   ); setq
 ); repeat
 mv-list
) ;_ end of do-dims

(defun do-mtxt (m-list)
 (setq mv-list nil)
 (repeat (length m-list)
   (setq ent      (car m-list)
         mtxt-val (dxf 1 ent)
   ); setq
   (setq mv-list  (append mv-list (list mtxt-val))
         m-list   (cdr m-list)
   ); setq
 ); repeat
 mv-list
); do-mtxt

(defun nextchar (j) (setq char (substr mtxt j 1)))

(defun mtxt-2-txt (mtxt)
 (setq k     1
       bslsh "\134"
       txt   ""
       len   (strlen mtxt)
 ); setq
 (while (<= k len)
   (setq char (nextchar k))
   (if (= char bslsh)
     (progn
       (setq char (nextchar (setq k (1+ k))))
       (if (= char "S")
         (progn
           (setq char (nextchar (setq k (1+ k))))
           (if (= (type (read char)) 'INT)
             (progn
              (setq i-txt (do-sftxt k mtxt char txt)
                     k (car i-txt)
                     txt (cadr i-txt)
              ); setq
             ); progn
             (progn
               (setq k (get-semicolon k mtxt))
               (setq char (nextchar 
                       (setq k (1+ k)))
               ); setq
               (if (= (type (read char)) 'INT)
                 (progn
                   (setq i-txt 
                      (do-txt k mtxt txt)
                         k (car i-txt)
                         txt (cadr i-txt)
                   ); setq
                 ); progn
               ); if
             ); progn 
           ); if
         ); progn
         (progn
           (setq k (get-semicolon k mtxt))
           (setq char (nextchar (setq k (1+ k))))
           (if (= (type (read char)) 'INT)
             (progn
               (setq i-txt (do-txt k mtxt txt)
                     k (car i-txt)
                     txt (cadr i-txt)
               ); setq
             ); progn
           ); if
         ); progn           
       ); if
     ); progn 
     (progn
       (setq k (get-semicolon k mtxt))
       (setq char (nextchar (setq k (1+ k))))
       (if (= (type (read char)) 'INT)
         (progn
           (setq i-txt (do-txt k mtxt txt)
                 k (car i-txt)
                 txt (cadr i-txt)
           ); setq
         ); progn
       ); if
     ); progn is not backslash
   ); if backslash
 ); while
 txt
); mtxt-2-txt

(defun get-semicolon (i mtxt)
 (setq char      ""
       s-col    "\073"
       len      (strlen mtxt)
 ); setq
 (while (and (/= char s-col)
            (<= i len)
        ); or
   (setq char (nextchar (setq i (1+ i))))
 ); while
 i
); get-semicolon

(defun do-sftxt (i mtxt char txt)
;;; stacked or unstacked fractions
 (setq s-col    "\073"
       dquote   "\042"
       fslsh    "\057"
       numerator ""
       denom     ""
 ); setq
 (setq j i)
 (setq char (nextchar j))
 (while (/= char fslsh)
   (setq numerator (strcat numerator char))
   (setq char (nextchar (setq j (1+ j))))
 ); while
 (setq i (1+ j))
 (setq char (nextchar i))
 (while (and (/= char s-col) (/= char dquote))
   (setq denom (strcat denom char))
   (setq char (nextchar (setq i (1+ i))))
 ); while
 (setq num (atof numerator)
       den (atof denom)
       ans (/ num den)
 ); setq
 (setq txt (rtos (+ (atof txt) ans) 2 4))
 (list i txt)  
); do-sftxt

(defun do-txt (i mtxt txt)
;;;decimal or non-stacked fractions
 (setq dot      "\056"
       len      (strlen mtxt)
       i        (1- i)
       char     "1"
       txttemp  ""
       s-col    "\073"
       dquote   "\042"
       xopen    "\173"
       xclose   "\175"
       plus     "\053"
       minus    "\055"
       carat    "\136"
       dot      "\056"
       space    " "
       j        nil
 ); setq
 (setq chrlist (list xopen xclose s-col dquote
                     plus minus carat)
 ); setq
 (while (and (= (type (read char)) 'INT)
             (< i len)
        ); and
   (setq char (nextchar (setq i (1+ i))))
   (if (member char chrlist)
     (progn
       (setq j i
             i len
       ); setq
     ); progn
   ); if
   (if (/= char space)
     (progn
       (setq txttemp (strcat txttemp char))
       (if j  (setq i j))
     ); progn
     (progn
       (setq i-txt (do-sftxt i mtxt char txttemp))
       (setq i (car i-txt))
       (setq txttemp (cadr i-txt))
     ); progn
   ); if
   (if (= char dot) (setq char "1"))
 ); while
 (if (/= i len)
   (progn
     (setq txttemp (substr txttemp 1 
               (- (strlen txttemp) 1)))
     (setq i (1- i))
   ); progn
 ); if
 (setq txt (rtos (+ (atof txt) 
                    (atof txttemp)) 2 4))
 (list i txt)
); do-txt

(defun c:dsm () (dimsum))
(prompt "\nCopyright (C) 1999, Tony Hotchkiss")
(prompt "\nEnter DSM to start: ")

[BIGAL]

ok 1st "sumtotal" no checking done but a good guess not tested

 

add this at end of dimsum

 

(setq num (Getreal "enter number"))
(alert (strcat (Rtos num 2 0) " divisor interval = " (rtos (/ sumtotal num) 2 0)))
) ;_ end of dimsum
[code] 
 
Ps here in AUS we have DIM SIMS.

[JoeyG_77]

Thanks Al !! ... Worked perfect !!

I just changed the output reading for 4 decimals