Author Topic: biso "ShoutBox" question  (Read 6840 times)

0 Members and 1 Guest are viewing this topic.

daron

  • Guest
biso "ShoutBox" question
« on: October 11, 2006, 08:27:54 AM »
Quote from: biso
Today at 02:00:24 am
hi everyone. do you guys know of a lisp that calculates and addes numbers?

Let's see if this will work better for you, biso? It ususally gets better mileage if you post questions in the forum, vs. in the shoutbox.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: biso "ShoutBox" question
« Reply #1 on: October 11, 2006, 11:15:40 AM »
Try this.
Code: [Select]
(defun c:Calc (/ ActDoc Opt cnt ss ObjList tmpNum Pt CurSpace Ent Obj)
; Calculate text objects.
; Sub's 'tmw:ss->Objlist 'GetNumber 'GetCurrentSpace

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark ActDoc)
(initget "+ - * /")
(setq Opt (getkword "\n Select operation to do [<+> - * /]: "))
(if (not Opt)
 (setq Opt "+")
)
(if (or (= Opt "-") (= Opt "/"))
 (prompt "\n--| Rember that order matters. Select subtracted/divided by number first!!")
)
(if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
 (progn
  (setq ObjList (tmw:ss->ObjList ss))
  (foreach Obj ObjList
   (if (setq tmpNum (GetNumber (vla-get-TextString Obj)))
    (if cnt
     (setq cnt ((eval (read Opt)) cnt tmpNum))
     (setq cnt tmpNum)
    )
   )
  )
  (if cnt
   (progn
    (prompt (strcat "\n  Value = " (rtos cnt)))
    (initget "Replace Create")
    (setq Opt (getkword "\n <R>epalce existing text, or Create new text object: "))
    (if (= Opt "Create")
     (progn
      (setq Pt (getpoint "\n Select insertion point of text: "))
      (setq CurSpace (GetCurrentSpace ActDoc))
      (vla-AddText CurSpace (rtos cnt) (vlax-3d-point Pt) (getvar "textsize"))
     )
     (if (setq Ent (ssget "+.:E:S" '((0 . "TEXT,MTEXT"))))
      (progn
       (setq Obj (vlax-ename->vla-object (ssname Ent 0)))
       (vla-put-TextSTring Obj (rtos cnt))
      )
      (prompt (rtos cnt))
     )
    )
   )
  )
 )
)
(vla-EndUndoMark ActDoc)
(princ)
)
;--------------------------------------------------------------------------------
(defun GetNumber (Str / tmpStr ChkStr)
; Retrun a number if one is in the string supplied, or nil if not.

(setq tmpStr "")
(while
 (and
  (/= Str "")
  (setq ChkStr (substr Str 1 1))
  (if (not (<= 48 (ascii ChkStr) 58))
   (if (not (= 46 (ascii ChkStr)))
    T
   )
  )
 )
 (setq Str (substr Str 2))
)
(while
 (and
  (/= Str "")
  (setq ChkStr (substr Str 1 1))
  (or
   (<= 48 (ascii ChkStr) 58)
   (= 46 (ascii ChkStr))
   (= 44 (ascii ChkStr))
  )
 )
 (if (/= 44 (ascii ChkStr))
  (setq tmpStr (strcat tmpStr ChkStr))
 )
 (setq Str (substr Str 2))
)
(if (/= tmpStr "")
 (distof tmpStr)
)
)
;----------------------------------------------------------------------
(defun tmw:ss->Objlist (ss / RtnList temp1)

(while (setq temp1 (ssname ss 0))
 (setq RtnList (cons (vlax-ename->vla-object temp1) RtnList))
 (ssdel temp1 ss)
)
RtnList
)
;-----------------------------------------------------------------------
(defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
; Returns the "block object" for the active space
; Thanks to Jeff Mishler

(if (= (getvar "cvport") 1)
 (vla-get-PaperSpace Doc)
 (vla-get-ModelSpace Doc)
)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

flopo

  • Guest
Re: biso "ShoutBox" question
« Reply #2 on: September 13, 2010, 03:49:16 AM »
Hello Willey,
Can you modify your lisp to do something more? Let's say i have 10 numbers, each of them as text or mtext, in a table, but not a "proper" table ( i mean a table created using lines and text ot mtext, not using Table command)- and i want to divide all of them by...2-for example. Can your routine do this? Thanks!

fixo

  • Guest
Re: biso "ShoutBox" question
« Reply #3 on: September 13, 2010, 05:30:27 AM »
Try this routine, not tested extensively
Code: [Select]

(defun c:demo(/ elist ent_list num pos precision sign ss text)
(if
(setq ss (ssget (list (cons 0 "*TEXT"))))
(progn
(setq ent_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(initget 1 "+ - * /")
(setq sign (getkword "\nChoose an operator [+/-/*//] </> : "))
(initget 2)
(setq num (getreal "\nSpecify numer : "))
(mapcar
  (function (lambda (e)
      (setq elist (entget e))
      (setq precision (if
(setq pos (vl-string-search
    "."
    (setq text (cdr (assoc 1 elist)))))
(- (strlen text) pos 1)
0
)
    )
      (setq elist     (entmod (subst
    (cons 1
  (if (not (zerop precision))
  (rtos ((vl-symbol-value (read sign))
  (atof (cdr (assoc 1 elist)))
  num) 2
precision)
    (itoa (fix ((vl-symbol-value (read sign))
  (atof (cdr (assoc 1 elist)))
  num))
)
  )
    )
    (assoc 1 elist) elist)
      )
    )
    (entupd (cdr (assoc -1 elist))))
  )
ent_list)
)
)
(princ)
)

~'J'~

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: biso "ShoutBox" question
« Reply #4 on: September 13, 2010, 07:46:01 AM »
Hi,

Search the forums for TextMath  :wink:

Bob Wahr

  • Guest
Re: biso "ShoutBox" question
« Reply #5 on: September 13, 2010, 09:18:07 AM »
There's a shoutbox?

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Re: biso "ShoutBox" question
« Reply #6 on: September 13, 2010, 10:14:28 AM »
Bob, There use to be one. That went away a long time ago.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

Bob Wahr

  • Guest
Re: biso "ShoutBox" question
« Reply #7 on: September 13, 2010, 02:28:13 PM »
lol, missed the zombitude of the thread.

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: biso "ShoutBox" question
« Reply #8 on: September 13, 2010, 03:41:04 PM »
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox