;;; TXTSUM.LSP
;;; Routine that allows for pick of text, dimensions and attributes
;;; in order to do calculation with numbers in the text. Valid are
;;; strings that entirely represents a number or that has a number
;;; at the leftmost position, which is separated from alpha characters
;;; with a space, tabulation, quote or double quote (newline character
;;; in MTEXT is not a valid separator!).
;;; Units allowed by LUNITS are valid. If a number of any format
;;; is not separated by the above characters from alpha characters,
;;; it will not be regarded as a number (normal behavior of READ).
;;; No angle units are handled, - only linear units.
;;; NOTE: For dimensions, only the actual measurement will be read.
;;; October 2004, Stig Madsen
;;; Modified by Igal Averbuh 2015 - added option to put sum as text into drawing

(defun getNent_kWords (msg lst kwords / ent)
(setvar "ERRNO" 0)
(and (not msg) (setq msg "\nSelect object: "))
(while (and (not ent) (/= (getvar "ERRNO") 52))
(and kwords (initget kwords))
(setq ent (nentsel msg))
(cond
((= (type ent) 'STR))
((vl-consp ent)
(cond ((> (length ent) 2)
(cond
((member (cdr (assoc 0 (entget (last (last ent))))) lst)
(setq ent (last (last ent))))
((member (cdr (assoc 0 (entget (car ent)))) lst)
(setq ent (car ent)))
((princ "\nNot a valid object") (setq ent nil))
)
)
((member (cdr (assoc 0 (entget (car ent)))) lst)
(setq ent (car ent)))
((princ "\nNot a valid object") (setq ent nil))
)
)
)
)
ent
)

(defun C:add (/ ent entl func cont txtsum lastsum undosum used useUsed)
(defun printCurrent (sum) (and sum (princ (strcat "\nCurrent result: " (rtos sum)))))
(vl-load-com)
(setq func '+)
(while (setq ent (getNent_kWords
(strcat "\nSelect text or [+/-/*/Div/Undo] (current: "
(vl-princ-to-string func) "): ")
'("TEXT" "MTEXT" "DIMENSION" "ATTRIB")
"+ - * Div / Undo"
)
)
(cond
;; if entity of type TEXT, MTEXT or DIMENSION go get supposed number ...
((= (type ent) 'ENAME)
(setq entl (entget ent))
(cond ((member (cdr (assoc 0 entl)) '("TEXT" "MTEXT" "ATTRIB"))
(setq cont (cdr (assoc 1 entl)))
;; figure out the format with various DISTOF units.
;; if no DISTOF format is recognized, simply READ it
;; and see if something can be obtained from the string
(setq cont (cond ((distof cont 1))
((distof cont 2))
((distof cont 3))
((distof cont 4))
((distof cont 5))
((read cont))
)
)
)
;; got a dimension .. just read the measurement
((= (cdr (assoc 0 entl)) "DIMENSION")
(setq cont (cdr (assoc 42 entl)))
)
)
(cond
((and (not txtsum)(numberp cont))
(setq txtsum cont lastsum txtsum used (cons ent used))
(printCurrent txtsum))
;; see if it really holds a number
((numberp cont)
;; add last result to undo list
(setq undosum (cons lastsum undosum))
;; ... and see if it has already been used
(if (cond ((member ent used)
(initget "Yes No")
(cond ((/= "No"
(getkword "\nAdd object already used? [Yes/No] : "))
T)))
(T)
)
(progn
(if (and (= func '/)(zerop cont))
(princ "\nDivide by zero error")
(setq txtsum (apply func (list txtsum cont))))
(princ (strcat "\n" (rtos lastsum) " " (vl-princ-to-string func)
" " (rtos cont) " = " (rtos txtsum)))
);_ progn
(printCurrent txtsum)
) ; if
(setq used (cons ent used) lastsum txtsum)
) ;_ numberp
((princ "\nNo numeric value found")(printCurrent txtsum))
) ;_ cond
) ;_ type ENAME
;; if string then it must have been returned by getEnt_kWords and
;; is either "+", "-", "*" or "Div" (or "/"). Go set up function to use
((= (type ent) 'STR)
(cond ((= ent "Div") (setq func '/))
((= ent "Undo")
;; if undo can be done, go get the previous result and
;; chop off the undo list
(if undosum
(setq txtsum (car undosum) lastsum txtsum undosum (cdr undosum))
(princ "\nNothing to undo")
)
(printCurrent txtsum)
)
((setq func (read ent)))
)
)
) ;_ cond
) ;_ while
(and txtsum (princ (strcat "\nTotal: " (rtos txtsum))))
(princ)

(setq en (car (entsel "\nSelect text to update to total"))
ed (entget en)
et (dxf 0 ed)
)
(if (or (= et "TEXT")(= et "MTEXT")) ; verify text or mtext was selected **12/20/12**
;(rtos txtsum 2) returns total formated as a string in decimal format
;substitute the new text for the old text...
;(setvar "CMDECHO" 0)
(progn
(entmod
(setq ed (subst (cons 1 (rtos txtsum 2)) (assoc 1 ed) ed))
);entmod
)
);if

;(setvar "CMDECHO" 1)

)

(c:add)

Advertisements