Topic: (challenge) Calculation using existing number string

[JohnK]

Just a small challenge today. Hopefully we can get some beginners in on this one.

Given a number string that is only meant to be a number--if you had a text entity for a Square Foot area or something along those lines--preform a calc on the number, replace the string and make the text string the color red.

NOTES: This one is once thru; it doesn't matter if its ``correct'' just if the job gets done. Let me see your coding thought process. Imagine that you got yourself in a sticky situation and you need to get out of it real quick!

HISTORY: This came about because I spent some time gathering square footage areas, and stuff on my plans. Later noticed that I used the wrong floor to floor height--I used 14.5 ft instead of 18--so I had to re-calc quite a few numbers quick. I decided to create some code to change the values for me but I also thought this might make a quick and neat challenge.

[JohnK]

Okay, that idea flopped.

But here was my 10 min solution anyways:

Code: [Select]

(defun c:tt ( / txt elst nu )
  ;; take a given text string number and preform a quick re-calc on it
  ;; and set it to the color red.
  ;; by: John K
  ;;     4/13/2007 8:12:04 AM
  (setq txt (car (entsel))
        ;; get the selection
        elst (entget txt)
        ;; get the ent data
        nu (if (or
                 (eq (cdr (assoc 0 elst)) "MTEXT")
                 (eq (cdr (assoc 0 elst)) "TEXT"))
             ;; do a brief check to see if its text
             (distof (cdr (assoc 1 elst)) 1)))
  ;; do a conversion on the string to get the int.
  (if nu
    ;; if we have a number
    (progn
      (setq nu (/ nu 14.5)
            nu (* nu 18))
      ;; preform the calc
      (setq elst (entmod (subst '(62 . 2) (assoc 62 elst) elst)))
      ;; put number back in the ent's data list
      (entmod (subst (cons 1 (rtos nu 2 2)) (assoc 1 elst) elst))
      ;; make it red
      )
    ); if
 (princ)
)
Remember, this was custom to the need so...

[VVA]

My variant. It is indifferent to formatting MTEXT, to formatting %% u %% o, to a divider "." or ",". Processes MTEXT with several paragraphs.

Code: [Select]

;helper function. Unformat Mtext
(defun mip_MTEXT_Unformat ( Mtext / text Str )
  (setq Text "")
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or(= " " (substr Text (strlen Text)))
   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
  ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))
  ))
  Text
  )
;helper function
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
(defun C:TT ( / ent ss str res)
(vl-load-com)(princ "\nSelect text")
(if (setq ss (ssget "_+.:S:E:L" '((0 . "*TEXT"))))
  (progn
    (setq ent (ssname ss 0)
          str (str-str-lst (vla-get-textstring (setq ent (vlax-ename->vla-object ent))) "\\P")
    str (mapcar '(lambda(x)(mip_mtext_unformat x)) str)
      str (mapcar '(lambda(x)(vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))) str)
      res (mapcar 'atof str)
      res (mapcar '(lambda(nu)
                     (setq nu (/ nu 14.5)
                           nu (* nu 18)))
            res)
      res (apply 'strcat
           (mapcar '(lambda(x)(strcat (rtos x 2 2) "\\P")) res))
    res (vl-string-right-trim "\\P" res)
          );_setq
    (vla-put-textstring ent res)
    (vla-put-color ent 1)
    )
  )
  (princ)
  )


[Fatty]

Hi John
Hope I'd understand you correct
Give this a try also

Code: [Select]

(defun ChNumberPart (source coeff mode prec / change numbers outstr)
  ;; arguments:
  ;; source - exising string
  ;; coeff - coefficient
  ;; mode - an integer specifying the linear units mode
  ;; prec - an integer specifying the precision
  ;; outstr - resulting string
  ;; Thanks to Tony Tanzillo for this example
(vl-load-com)
(setq Regul (vlax-create-object "VBScript.RegExp"))
(vlax-put Regul 'Global :vlax-true)
(vlax-put Regul 'IgnoreCase :vlax-true) 
(vlax-put Regul 'Pattern "[~a-z,A-Z, ]");<-- pattern to remove numbers only
(setq numbers (vlax-invoke Regul 'Replace source ""))
(setq change (rtos (* (atof numbers) coeff) mode prec))
(vlax-put Regul 'Pattern numbers)
(setq outstr (vlax-invoke Regul 'Replace source change))
(vlax-release-object Regul)
outstr 
)

;; Call :

Code: [Select]

(defun C:test()
 (or (vl-load-com))
  (or adoc
      (setq adoc
     (vla-get-activedocument
       (vlax-get-acad-object)
     )
      )
  )
(ssget (list (cons 0 "*TEXT")))
(vlax-for a (vla-get-activeselectionset adoc)
(vl-catch-all-apply (function (lambda()
(progn      
(vla-put-textstring a
  (ChNumberPart (vla-get-textstring a) (/ 18 14.5) 2 2))
(vla-put-color a acred))))))
  (princ)
  )

~'J'~