Multification factor of 0.9 for final sum

[Anonymous]

Please update the below code with 0.9 multiplication factor for both prefix and suffix alphabets 

(defun C:9FS (/ cpent elist en ip newtxt pt ss sum sumtxt txt)
(princ "\n\t\t>>> Select text to get summ >>>")
(if
;;select texts/mtexts on screen :
(setq ss (ssget '((0 . "*TEXT"))))
;; if selected then :
(progn
;; store the first text entity for using 'em further :
(setq cpent (ssname ss 0))
;; set initial sum to zero :
(setq sum 0.)
;; loop trough selected texts/mtexts :
(while
;; get the first text in selection :
(setq en (ssname ss 0))
;; get entity list of them :
(setq elist (entget en))
;; get the textstring by key 1 from entity list :
(setq txt (cdr (assoc 1 elist)))
;; create output string :
(setq sumtxt
;; concatenate strings :
(strcat
;; convert digits to string :
(rtos
;; add to summ the digital value of text :
(setq sum (+ (atof (vl-list->string (vl-remove-if-not '(lambda (x) (member x '(46 48 49 50 51 52 53 54 55 56 57))) (vl-string->list txt)))) sum))
;; 2 is for metric units (3 for engineering) :
2
;; set precision by current :
(getvar "dimdec")))
)
;; delete entity from selection set :
(ssdel en ss)
)
;; display message in the command line:
(princ (strcat "\nSumm=" sumtxt))
(setq pt (getpoint "\nSpecify the new text location: "))
;; get the insertion point of stored entity :
(setq ip (cdr (assoc 10 (entget cpent))))
;; copy text entity to the new destination point :
(command "_copy" cpent "" ip pt)
;; get the last created entity :
(setq newtxt (entlast))
;; get entity list of them :
(setq elist (entget newtxt))
;; modify entity list with new text string :
(entmod (subst (cons 1 sumtxt)(assoc 1 elist) elist))
;; update changes :
(entupd newtxt)
)
)
(princ)
)
(princ "\nStart command with STX...")
(princ)

[dbhunia · Accepted solution]

hi,

Can u send Sample file

[dbhunia · Accepted solution]

---

@Anonymous wrote:

Please update the below code with 0.9 multiplication factor for both prefix and suffix alphabets 

---

Hi,

Assuming your string format is like "45.5 DGDG 45.9 SDG 5.5" then the code will give you "40.9500 DGDG 41.3100 SDG 4.9500".

(It has been tested in "AutoCAD 2007", hope fully it will work in latest version. Otherwise you have to wait till Monday)

Decimal part will depend o your system variable (dimdec) setting.

Another thing Give your feedback on your raised topic "HELP TO MODIFY LISP (SELECTED BLOCK NAME TO SELECTED TEXT VALUE)"

[Kent1Cooper · Accepted solution]

If I understand correctly what you want to do [it would be clearer with an example]….

I don't understand making the text version of the numerical sum after every Text piece's number content is added into it -- wait until it's all added up, and make it into Text once.  Also, the (strcat) function does nothing, with only one string to concatenate with itself.  And there's no point in specifying the precision argument in (rtos) with (getvar 'dimdec) -- that's what it will always use unless you specify something different.

I think the core of it would be [untested]:

….
(while (setq en (ssname ss 0))
  (setq
    elist (entget en)
    txt (cdr (assoc 1 elist))
    sum (+ (atof (vl-list->string (vl-remove-if-not '(lambda (x) (member x '(46 48 49 50 51 52 53 54 55 56 57))) (vl-string->list txt)))) sum)
  ); setq
  (ssdel en ss)
); while
(setq sumtxt (rtos (setq sum (* sum 0.9)) 2))
(princ (strcat "\nSumm x 0.9 = " sumtxt))
….

[Kent1Cooper · Accepted solution]

---

@dbhunia wrote:

….

Assuming your string format is like "45.5 DGDG 45.9 SDG 5.5" then the code will give you "40.9500 DGDG 41.3100 SDG 4.9500".

…. 

---

My interpretation was different [and surely may be incorrect].  I assume they will have Text objects that could have either prefixes or suffixes [or both?] that are alphabetical, before and/or after the numerical  parts that they want to add up, such as "23.5ABC" and "FP-98.654" and "X12BT".  And that they want the total of those numerical parts [in this case 134.154] to be multiplied by 0.9 [120.7386] for the sum reports to the command line and in the new Text object.

This is why a sample drawing or even an image would help -- it should not be necessary for us to make assumptions.

[dbhunia · Accepted solution]

Hi Kent,

You are absolutely right......

That's why I already asked @Anonymous for a sample file.....

[Anonymous]

Worlikng like charm. Nice

[dbhunia · Accepted solution]

Hi

Try also this... it covers like "23.5ABC", "FP-98.654", "X12.50BT", "67.923 TB/SYM 40.995", "511.5377", "X12.50BT45.55" i.e. any alphanumeric types.....

(defun C:TEST (/)
(setq sum 0)
(setq ss (ssget '((0 . "*TEXT"))))
(while (setq en (ssname ss 0))
(progn
(setq
elist (entget en)
txt (cdr (assoc 1 elist))
Char (vl-string->list txt)
ss_new (ssadd)
)
(setq N 0)
(setq sumtxt1 "")
(repeat (setq No (length Char))
(setq Char_Val (nth N Char))
(setq N (+ N 1))
(if (or (< 47 Char_val 58) (= 46 Char_val))
(progn
(setq sumtxt1 (strcat sumtxt1 (rtos Char_val) " "))
(setq Number 0)
);progn
(progn
(if (= Number 0)
(progn
(setq Read_Char (read (strcat "(" sumtxt1 ")")))
(setq Read_Num (atof (vl-list->string Read_Char)))
(setq sum (+ sum Read_Num))
(setq Number 1)
(setq sumtxt1 "")
)progn
);if
);progn
);if
;(print Char_Val)
);repeat
(if (= Number 0)
(progn
(setq Read_Char (read (strcat "(" sumtxt1 ")")))
(setq Read_Num (atof (vl-list->string Read_Char)))
(setq sum (+ sum Read_Num))
(setq Number 1)
(setq sumtxt1 "")
)progn
);if
);progn
(ssdel en ss)
);while
(setq sumtxt (rtos (setq sum (* sum 0.9)) 2 (getvar "dimdec")))
(princ (strcat "\nSumm x 0.9 =" sumtxt))
(setq pt (getpoint "\nSpecify the new text location: "))
(setq ip (cdr (assoc 10 (entget cpent))))
(command "_copy" cpent "" ip pt)
(setq newtxt (entlast))
(setq elist (entget newtxt))
(entmod (subst (cons 1 sumtxt)(assoc 1 elist) elist))
(entupd newtxt)
)

[dbhunia · Accepted solution]

Hi,

I know you got your solution........

But you also can try this latest code ............it covers like "23.5ABC", "FP-98.654", "X12.50BT", "X12.50BT45.55", "MM67.923 TB/SYM 40.995", "511.5377" i.e. any alphanumeric / Numeric types values, position of Numbers does not matter .....

(defun C:9FS (/)
(setq sum 0)
(setq ss (ssget '((0 . "*TEXT"))))
(while (setq en (ssname ss 0))
(progn
(setq
elist (entget en)
txt (cdr (assoc 1 elist))
Char (vl-string->list txt)
cpent (ssname ss 0)
)
(setq N 0)
(setq sumtxt1 "")
(repeat (setq No (length Char))
(setq Char_Val (nth N Char))
(setq N (+ N 1))
(if (or (< 47 Char_val 58) (= 46 Char_val))
(progn
(setq sumtxt1 (strcat sumtxt1 (rtos Char_val 2 0) " "))
(setq Number 0)
);progn
(progn
(if (= Number 0)
(progn
(setq Read_Char (read (strcat "(" sumtxt1 ")")))
(setq Read_Num (atof (vl-list->string Read_Char)))
(setq sum (+ sum Read_Num))
(setq Number 1)
(setq sumtxt1 "")
)progn
);if
);progn
);if
;(print Char_Val)
);repeat
(if (= Number 0)
(progn
(setq Read_Char (read (strcat "(" sumtxt1 ")")))
(setq Read_Num (atof (vl-list->string Read_Char)))
(setq sum (+ sum Read_Num))
(setq Number 1)
(setq sumtxt1 "")
)progn
);if
);progn
(ssdel en ss)
);while
(setq sumtxt (rtos (setq sum (* sum 0.9)) 2 (getvar "dimdec")))
(princ (strcat "\nSumm x 0.9 =" sumtxt))
(setq pt (getpoint "\nSpecify the new text location: "))
(setq ip (cdr (assoc 10 (entget cpent))))
(command "_copy" cpent "" ip pt)
(setq newtxt (entlast))
(setq elist (entget newtxt))
(entmod (subst (cons 1 sumtxt)(assoc 1 elist) elist))
(entupd newtxt)
)