TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: daron on October 11, 2006, 08:27:54 AM

Title: biso "ShoutBox" question
Post by: daron 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.

Title: Re: biso "ShoutBox" question
Post by: T.Willey 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)
)
)


Title: Re: biso "ShoutBox" question
Post by: flopo 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!

Title: Re: biso "ShoutBox" question
Post by: fixo 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'~

Title: Re: biso "ShoutBox" question
Post by: Lee Mac on September 13, 2010, 07:46:01 AM

Hi,

Search the forums for TextMath  :wink:

Title: Re: biso "ShoutBox" question
Post by: Bob Wahr on September 13, 2010, 09:18:07 AM

There's a shoutbox?

Title: Re: biso "ShoutBox" question
Post by: JohnK on September 13, 2010, 10:14:28 AM

Bob, There use to be one. That went away a long time ago.

Title: Re: biso "ShoutBox" question
Post by: Bob Wahr on September 13, 2010, 02:28:13 PM

lol, missed the zombitude of the thread.

Title: Re: biso "ShoutBox" question
Post by: alanjt on September 13, 2010, 03:41:04 PM

http://www.theswamp.org/index.php?topic=32984.0