;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; TextOperator.lsp ;;; ;;; Created by Jonathan Handojo ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; This LISP routine allows the user to replace numbers parsed from a string by performing a ;;; ;;; mathematical operation using another number. For example, the text below entails a ;;; ;;; linetype within a "*.lin" file: ;;; ;;; ;;; ;;; "2 apples, 5 bananas, 4 oranges, 3 grapes" ;;; ;;; ;;; ;;; An MTEXT object containing this string can be modified using this routine to achieve the ;;; ;;; below: ;;; ;;; "4 apples, 7 bananas, 6 oranges, 5 grapes" ;;; ;;; ;;; ;;; By adding all the numbers found within the string by 2. ;;; ;;; ;;; ;;; This LISP routine references several authors and I would like to thank Lee Mac and Alan H ;;; ;;; for their LISP codes to aid me with creating this program. However, I did make some slight ;;; ;;; modifications to their original reference to suit the needs to this program. ;;; ;;; ;;; ;;; The program works by first invoking the TOP (Text OPerator) command. The user will be ;;; ;;; prompted to select an object that has a text property (except blocks). Following this, the ;;; ;;; program will attempt to parse the numbers from the string (using Lee Mac's "Parse Numbers" ;;; ;;; function), then a dialog box will pop up (using Alan H's MultipleToggles.lsp routine) ;;; ;;; entailing which numbers to include for being modified. [In the example above, all the ;;; ;;; numbers are modified.]. ;;; ;;; ;;; ;;; The above continues until the user is satisfied and types "End" or by pressing Enter. A ;;; ;;; list of options are available as an operator: ;;; ;;; ;;; ;;; "Add" � adds the selected numbers with another number prompted after this prompt. ;;; ;;; "Subtract" � subtracts the selected numbers with another number ;;; ;;; "Multiply" � multiplies the selected numbers with another number ;;; ;;; "Divide" � divides the selected numbers with another number ;;; ;;; "Exponential" � raises the selected numbers to a power of another number ;;; ;;; "Minimum" � returns the minimum of each of the selected numbers with another ;;; ;;; "Maximum" � returns the maximum of each of the selected numbers with another ;;; ;;; ;;; ;;; The next prompt is the number associated with the operator. All the numbers within the ;;; ;;; text will then be calculated. ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; ------------------------------------------------------------ ;;; ;;; Adding New Operators ;;; ;;; ------------------------------------------------------------ ;;; ;;; ;;; ;;; New operators can be added into this routine by defining your own user-defined function, ;;; ;;; given that the function: ;;; ;;; ;;; ;;; 1. Accepts exactly two arguments: two numbers (integer or real) ;;; ;;; 2. Returns another number (integer or real) ;;; ;;; ;;; ;;; See more details within the code. ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; This code however has some disadvantages: ;;; ;;; ;;; ;;; 1. By using ParseNumbers on MTEXT, this will also parse any formatting on MTEXT. For this ;;; ;;; reason, I used LM:Unformat to unformat the string. That would mean the text in MTEXT will ;;; ;;; appear without any formatting. ;;; ;;; ;;; ;;; 2. This program does not keep any preceding zeros (if the number is "00012" and you "Add" ;;; ;;; it by "2", the resulting text will be "14" as opposed to "00014" ;;; ;;; ;;; ;;; 3. If the resulting number is a real number that has a decimal of 0 (3.0), the result ;;; ;;; will be fixed to an integer. ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; Versions and Updates ;;; ;;; ---------------------------------- ;;; ;;; Version 1.0 (12/08/20) � First release ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:top ( / *error* activeundo acadobj adoc fncs msp dets num nums op opts prp start str txt) (defun *error* ( msg ) (vla-EndUndoMark adoc) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) msp (vla-get-ModelSpace adoc) activeundo nil) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) (setq fncs '( ("Add" . +) ("Subtract" . -) ("MUltiply" . *) ("Divide" . /) ("Exponential" . expt) ("MInimum" . min) ("MAximum" . max) ;; Feel free to add more to the above in the form of (a . b) where: ;; a = the text to appear when the user is prompted for the operator (NO SPACES PLEASE) ;; b = the function ;; Do note for the variable 'b': ;; 1. The function should accept two arguments: ;; - The first argument [int/real] is the original number parsed from the text; ;; - The second argument [int/real] is the number associated with the operator. ;; a. If it's a built-in function, use a function that accepts at least two arguments (For example: rem, logand, ...) ... Both numbers ;; b. If it's user-defined, use a function that accepts exactly two arguments... Both numbers ;; 2. The value returned by the function should be a number, be it a floating number or whole number. ;; ;; Examples: ;; ;; ("REplace" . (lambda (x y) y)) ;; ("MEan" . (lambda (x y) (* 0.5 (+ x y)))) ;; ("ROunddown" . LM:rounddown) ) ) (while (progn (setvar 'errno 0) (setq txt (progn (initget "End") (entsel "\nSelect object containing text [End] :"))) (cond ((= (getvar 'errno) 7) (princ "\nNothing selected")) ((or (null txt) (eq txt "End")) nil) ((progn (setq txt (vlax-ename->vla-object (car txt)) prp (vl-some '(lambda (x) (if (vlax-property-available-p txt x) (vl-princ-to-string x)) ) '(TextString TextOverride) ) ) (not prp) ) (princ "\nObject does not have a text property") ) ((assoc txt dets) (princ "\nObject is already selected previously")) (t (setq str (eval (read (strcat "(vla-get-" prp " txt)"))) nums (LM-JH:parsenumbers->str (LM:UnFormat str nil)) ) (if nums (setq opts (mapcar 'cons nums (AH-JH:Toggs (cons "Select numbers to include in operation" nums))) dets (cons (cons txt opts) dets) ) (princ "\nNo numbers detected.") ) ) ) ) ) (if (vl-remove-if '(lambda (x) (eq (cdr x) "0")) (apply 'append (mapcar 'cdr dets))) (progn (setq op (progn (initget 1 (setq opts (JH:lst->str (mapcar 'car fncs) " "))) (eval (cdr (assoc (getkword (strcat "\Select an operator [" (vl-string-translate " " "/" opts) "]: ")) fncs)))) num (progn (initget 1) (getreal "\nSpecify the number to apply to the operator: ")) num (if (equal num (fix num)) (fix num) num) dets (mapcar '(lambda (x) (cons (car x) (mapcar '(lambda (y) (cons (car y) (if (eq (cdr y) "1") (if (and (eq op /) ; Because '/' returns an integer if two integers are provided --> (/ 11 3) -> 3 (which is incorrect) (not (zerop (rem (read (car y)) num))) ) (op (read (car y)) (float num)) (op (read (car y)) num) ) ) ) ) (cdr x) ) ) ) dets ) start 0 ) (foreach x dets ((lambda (a / ent n nmd pos) (setq ent (car a) str (LM:UnFormat (eval (read (strcat "(vla-get-" prp " ent)"))) nil)) (while (setq a (cdr a)) (setq pos (cond ((vl-string-search (caar a) str (cond (pos) (0)))) (0))) (if (cdar a) (setq str (vl-string-subst (setq nmd (rtos (cdar a) 2 (cond ((vl-string-search "." (setq n (vl-prin1-to-string (cdar a)))) (- (strlen n) (vl-string-search "." n) 1) ) ((vl-string-search "." (caar a)) (- (strlen (caar a)) (vl-string-search "." (caar a)) 1) ) (0) ) ) ) (caar a) str (cond (pos) (0)) ) ) ) (setq pos (+ pos (strlen (cond (nmd) ((caar a)))))) ) (eval (read (strcat "(vla-put-" prp " ent str)"))) ) x ) ) ) ) (if activeundo nil (vla-EndUndoMark adoc)) (princ) ) ;; JH:lst->str --> Jonathan Handojo ;; Concatenates a list of string into one string with a specified delimeter ;; lst - list of strings ;; del - delimiter string (defun JH:lst->str (lst del) (apply 'strcat (append (list (car lst)) (mapcar '(lambda (x) (strcat del x)) (cdr lst)))) ) ;;; ------------------------------ ONLINE REFERENCES ------------------------------ ;;; ;; LM-JH:parsenumbers->str --> Jonathan Handojo (Reference: Lee Mac (Parse Numbers)) ;; Parses a list of numbers from a string, returning the list in strings instead of numbers. ;; To account for effects of dimzin as a result of atof, find and replace numbers in text. ;; Original: (LM:parsenumbers "-5.56345678436ty8.2t6.") --> (-5.56346 8.2 6) depending on dimzin and other factors. ;; This code is originally from Lee Mac, tweaked a few lines to adjust. (defun LM-JH:parsenumbers->str (str) ((lambda (x) (vl-remove "" (read (strcat "(\"" (vl-list->string (apply 'append (mapcar '(lambda (w y z / ) (cond ((or (<= 48 y 57) (and (= y 45) (<= 48 z 57) (not (<= 48 w 57))) (and (= y 46) (<= 48 w 57) (<= 48 z 57)) ) (list y) ) ((and (<= 48 w 57) (null (<= 48 y 57))) '(34 32 34) ) ) ) (cons nil x) x (append (cdr x) '(nil)) ) ) ) "\")" ) ) ) ) (vl-string->list str) ) ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright � 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ; Multi toggle Dialog box for multi choice ; By Alan H Oct 2019 --> slight modifications by Jonathan Handojo in this file. ; Example code ; (if (not AH:Toggs)(load "Multiple toggles.lsp")) ; (setq ans (ah:toggs '("Yes or No" "Yes" "No"))) ; (if (not AH:Toggs)(load "Multiple toggles.lsp"))) ; (setq ans (ah:toggs '("A B C D" "A" "B" "C" "D"))) ; (if (not AH:Toggs)(load "Multiple toggles.lsp")) ; (setq ans (ah:toggs '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"))) (defun AH-JH:Toggs (ahbutlst / dcl_id fname fo keylst keynum mkv_lst v_lst x y) ; <-- variable DCL_ID made local (Jonathan Handojo) (defun mkv_lst ( / ) ; <-- mkv_lst made local to the function (Jonathan Handojo) (setq v_lst '()) (setq x 1) (repeat (1- (length ahbutlst)) (setq val (strcat "Tb" (rtos x 2 0))) (setq v_lst (cons (get_tile val) v_lst)) (setq x (1+ x)) ) ) (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line "AHtoggles : dialog {" fo) (write-line (strcat " label =" (chr 34) (nth 0 ahbutlst) (chr 34) " ;" )fo) (write-line " : column {" fo) (setq x 1) (repeat (- (length ahbutlst) 1) (write-line " : toggle {" fo) (write-line "alignment = left ;" fo) (write-line (strcat "key = " (chr 34) "Tb" (rtos x 2 0) (chr 34) ";") fo) (write-line (strcat "label = " (chr 34) (nth x ahbutlst) (chr 34) ";") fo) (write-line " }" fo) (write-line "spacer_1 ;" fo) (setq x (1+ x)) ) (write-line "spacer_1 ;" fo) (write-line " ok_cancel;" fo) (write-line " }" fo) (write-line " }" fo) (close fo) (setq dcl_id (load_dialog fname)) (if (not (new_dialog "AHtoggles" dcl_id) ) (exit) ) (setq y 0) (repeat (1- (length ahbutlst)) (setq keynum (strcat "Tb" (rtos (setq y (1+ Y)) 2 0))) (set_tile keynum "1") (mode_tile keynum 3) ) (action_tile "accept" "(mkv_lst)(done_dialog)") (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog dcl_id) (vl-file-delete fname) (reverse v_lst) ; <-- return value reversed (Jonathan Handojo) ) (vl-load-com)