Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

1,000 Comma Separator

15 REPLIES 15
Reply
Message 1 of 16
Anonymous
4616 Views, 15 Replies

1,000 Comma Separator

Happy New Year Y'All !!


Does anyone know of, or have a lisp routine that will plug in a comma for
the 1,000 separator in multiple lines of numbers ?

Example:

FROM: TO:

1236.43 1,236.43
24562.10 24,562.10
101293.43 101,293.43
3837321.43 3,837,321.43

Can anyone help me out? Or maybe there is something already built into
Autocad that I am not aware of.

Thanks a million!

Pat
A2k6
15 REPLIES 15
Message 2 of 16
Anonymous
in reply to: Anonymous

I pulled this from one of my lisp routines, original credit goes to John
Uhden

;;
;;
;; ****************************************
;; * == Add Commas == *
;; *
*
;; ****************************************
;;
;;
;; Code Source: John Uhden
;; This function pads a numeric string with commas.
;; Arguments:
;; num = any number, real or integer (>= 0)
;; # = precision, integer (>= 0)
;;
(defun rtoc (num # / p#)
(setq num (rtos num 2 #) # 1)
(while (and (/= (substr num # 1) ".")(<= # (strlen num)))
(setq # (1+ #))
)
(setq # (1- #) p# #)
(if (= (setq # (rem # 3)) 0)(setq # 3))
(while (< # p#)
(setq num (strcat (substr num 1 #) "," (substr num (1+ #)))
# (+ 4 #)
p# (1+ p#)
)
)
num
)

--

Gilbert L. "Chip" Harper

AutoDesk Discussion Group Facilitator
Web: http://www.hot4cad.com
Message 3 of 16
Anonymous
in reply to: Anonymous

Dear Chip,

What do I type in at the command prompt to get this guy going please?

Pat


"Chip Harper" wrote in message
news:5444748@discussion.autodesk.com...
I pulled this from one of my lisp routines, original credit goes to John
Uhden

;;
;;
;; ****************************************
;; * == Add Commas == *
;; *
*
;; ****************************************
;;
;;
;; Code Source: John Uhden
;; This function pads a numeric string with commas.
;; Arguments:
;; num = any number, real or integer (>= 0)
;; # = precision, integer (>= 0)
;;
(defun rtoc (num # / p#)
(setq num (rtos num 2 #) # 1)
(while (and (/= (substr num # 1) ".")(<= # (strlen num)))
(setq # (1+ #))
)
(setq # (1- #) p# #)
(if (= (setq # (rem # 3)) 0)(setq # 3))
(while (< # p#)
(setq num (strcat (substr num 1 #) "," (substr num (1+ #)))
# (+ 4 #)
p# (1+ p#)
)
)
num
)

--

Gilbert L. "Chip" Harper

AutoDesk Discussion Group Facilitator
Web: http://www.hot4cad.com
Message 4 of 16
Anonymous
in reply to: Anonymous

You don't ... this is a function ... one piece of a larger file, this
portion just adds the commas.
This comes from a routine that I wrote to do area calculations (SF, ACRES,
etc.). You would need to write the rest of the routine or do a search on the
newsgroups and/or Google for a comma lisp.

--

Gilbert L. "Chip" Harper

AutoDesk Discussion Group Facilitator
Web: http://www.hot4cad.com
Message 5 of 16
GODOYFP
in reply to: Anonymous

Try this one and let me know. Just load and use as follow by typing something like this on command prompt:

 

(comma 123456.123 2) then you get 123,456.12

 

or

 

(comma 123456.123 0) then you get 123,456

 

The 1st set of number is to number to add commas to, the 2nd is the precision #. This may be used as a function also and add to your existing lisp routines.

 

Enjoy !

 

;;
;;Function to Add Thousand comma separator to any number
;;
;;By Felix P. Godoy
;;03/10/2004
;;revs. 04/46/2005 Clean up / More efficent
;;

(defun comma ( Numb )

(setq lenNumb 0)
(setq lenwhole 0)
(setq lenNumb 0)
(setq decpos 0)
;(setq rBlock3 nil)
;(setq rBlock3cl nil)
(setq dunits (getvar "dimunit"))
(setq Number nil)
(setq FinalNumber nil)
(setq FoundE nil)
(setq NumberList nil)
(setq wholeList nil)
(setq rwholeList nil)

(setq strNumb (rtos Numb 2 dunits))

(setq FoundE (vl-string-search "E+" strnumb))

(setq lenNumb (strlen strNumb))

(setq decpos (vl-string-position 46 strNumb))

(if (null decpos)
(setq decpos 16)
)

(setq redFactor (- lenNumb decpos))

(setq wholeNumb (substr strNumb 1 decpos))

(setq wholeList (vl-string->list wholeNumb))

(setq rwholeList (reverse wholeList))

(setq rwholeNumb (vl-list->string rwholeList))

(setq lenwhole (strlen wholeNumb))

(setq startn 1)

(if (or (<= lenwhole 3) (= FoundE T))
(setq FinalNumber strNumb)
(progn

(while (/= "" rBlock3)

(setq rBlock3 (substr rwholenumb startn 3))

(setq rBlock3c (strcat rBlock3 ","))

(setq rBlock3cl (vl-string->list rBlock3c))

 (if (/= rBlock3cl nil)
 (setq NumberList (append (reverse rblock3cl) NumberList))
 )

(setq Number (vl-list->string NumberList))

(setq FinalNumber (vl-string-left-trim ",," Number))

(setq startn (+ startn 3))

)

);progn
);if


(princ)

);defun


; Reverses a string
(defun revs ( string )
   (vl-list->string (reverse (vl-string->list string)))
)

 

Message 6 of 16
Kent1Cooper
in reply to: GODOYFP

It's not returning anything for me -- not nil, not an empty text string, just nothing.  Also, your usage examples show giving it two arguments, but it's written for only one, and when I paste your examples in, it confirms that I've given it too many arguments.

Kent Cooper, AIA
Message 7 of 16
bhull1985
in reply to: Kent1Cooper

You could also do it like this, which would be called by typing "rtoc" into cad, followed by the number you wish to pad and the # of decimal places beyond the number you wish to have trailing

 

(defun C:rtoc (/ num # p#)
(setq num (getreal "Input number to pad:"))
(setq # (getint "Precision (amount):"))
(setq num (rtos num 2 #) # 1)
(while (and (/= (substr num # 1) ".")(<= # (strlen num)))
(setq # (1+ #))
)
(setq # (1- #) p# #)
(if (= (setq # (rem # 3)) 0)(setq # 3))
(while (< # p#)
(setq num (strcat (substr num 1 #) "," (substr num (1+ #)))
# (+ 4 #)
p# (1+ p#)
)
)
num
)

Minimally tested, uses getreal but I did not test if letters were inputted instead of numbers...common sense and an understanding of the english language required!

 HTH

 

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Please use code tags and credit where credit is due. Accept as solution, if solved. Let's keep it trim people!
Message 8 of 16
GODOYFP
in reply to: Kent1Cooper

There are 3 things to type in parenthesis at the command prompt: (comma
number #)

1. the command: comma
2. the number to add commas to
3. the # precision

I uploaded the actual lsp routine as coma.txt. Rename it coma.lsp. Load it
by just dropping into dwg.
Now type in parenthesis something like: (this comma is w/ 2 m's)

(comma 7654321 0) then you get 7,654,321

if you type

(comma 7654321 2) then you get 7,654,321.00

if you type

(comma 7654321.5678 1) then you get 7,654,321.6

and so on...

Let me know if this helps.


Peter
Message 9 of 16
GODOYFP
in reply to: GODOYFP

Try to use this instead

 

 

;;
;;Function to Add Thousand comma separator to any number
;;
;;By Felix P. Godoy 03/10/2004
;;
;;revs. 04/16/2005 Adds thosands comma separator to any number/ Clean up / More efficient
;;
;; Numb = any number
;; Prec = precision
;;

(defun comma ( Numb Prec / lenNumb lenwhole decpos rBlock3 rBlock3c rblock3cl Mode Number NumberList FinalNumber FoundE Found- wholelist rwholelist wholeNumb rwholeNumb afterdec strNumb redFactor startn commaNumber)

(setq lenNumb 0)
(setq lenwhole 0)
(setq decpos 0)
(setq rBlock3 nil)
(setq rBlock3cl nil)
(setq Mode (getvar "dimunit"))
(setq Number nil)
(setq FinalNumber nil)
(setq FoundE nil)
(setq Found- nil)
(setq NumberList nil)
(setq wholeList nil)
(setq rwholeList nil)

(setq strNumb (rtos Numb Mode Prec))
(setq FoundE (vl-string-search "E+" strnumb))
(setq Found- (vl-string-search "-" strnumb))
(setq decpos (vl-string-position 46 strNumb))
 (if (null decpos)
 (setq decpos 16)
 )
(setq redFactor (- lenNumb decpos))
(setq wholeNumb (substr strNumb 1 decpos))
(setq afterdec (vl-string-left-trim WholeNumb strNumb))
(setq wholeList (vl-string->list wholeNumb))
(setq rwholeList (reverse wholeList))
(setq rwholeNumb (vl-list->string rwholeList))
(setq lenwhole (strlen wholeNumb))
(setq startn 1)
 (if (or (<= lenwhole 3) (= FoundE T))
 (setq commaNumber strNumb)
 (progn
  (while (/= "" rBlock3)
  (setq rBlock3 (substr rwholenumb startn 3))
  (setq rBlock3c (strcat rBlock3 ","))
  (setq rBlock3cl (vl-string->list rBlock3c))
   (if (/= rBlock3cl nil)
   (setq NumberList (append (reverse rblock3cl) NumberList))
   )
  (setq Number (vl-list->string NumberList))
   (if (= Found- 0)
   (progn
   (setq FinalNumber (vl-string-left-trim ",,-," Number))
   (setq commaNumber (strcat "-" FinalNumber afterdec))
   )
   (progn
   (setq FinalNumber (vl-string-left-trim ",," Number))
   (setq commaNumber (strcat FinalNumber afterdec))
   );this progn
   );this if
  (setq startn (+ startn 3))
  (setq commaNumber commaNumber)
  );while ends
 );progn
 );if
);defun

; Reverses a string
(defun revs ( string )
   (vl-list->string (reverse (vl-string->list string)))
)

Message 10 of 16
Kent1Cooper
in reply to: GODOYFP


@GODOYFP wrote:
There are 3 things to type in parenthesis at the command prompt: (comma
number #)

1. the command: comma
2. the number to add commas to
3. the # precision
....
Load it by just dropping into dwg.
Now type in parenthesis something like: (this comma is w/ 2 m's)

(comma 7654321 0) then you get 7,654,321
....

I understand all of that, and did it all before [EDIT: with your first one (Message 5)], except that I put it into a .lsp file and APPLOADed it, rather than dropping it into the drawing.  Then, pasting one of your examples directly:

 

Command: (comma 7654321 0)
; error: too many arguments

 

I haven't a clue how you're getting away with giving it two arguments, when there's only one argument item listed in the parentheses after the function name on the (defun ... line -- that's what's giving me the error message.  Is what you have loaded really the same code as what you posted?  I tried omitting the precision, so it would at least have the right number of arguments, and did:

 

Command: (comma 7654321)

 

That's when I got nothing at all, not nil, not an empty string, no error message, but it just went back to the Command: prompt.

 

EDIT:  I see now that the later one does account for two arguments.

 

However, it has a problem for people like me who use Architectural Units, I expect because of its using the DIMUNIT System Variable for the mode argument in (rtos) functions.  I get, for example:

 

Command: (comma 1542324.3112 3)
"12,852,7'-,0 1,/4\""

 

And things involving calculation can come out not as intended, like:

 

Command: (comma (* 123456 987675.43) 3)
"1.219E+11"

 

Here's the approach I took:

 

(defun commify (num prec / numstr intstr decstr comstr)
  (setq
    numstr (rtos num 2 prec); eliminates any scientific-notation E+ element
    intstr ; integer portion as string
      ;; (itoa (fix num)) has problem with calculated returns in scientific notation,
      ;; so use (rtos) to 0 decimal places, but that rounds, possibly upward, so:
      (if (< (- num (fix num)) 0.5)
        (rtos num 2 0)
        (rtos (1- num) 2 0)
      ); if & intstr
    decstr (substr numstr (1+ (strlen intstr))); decimal portion as string ["" if no decimal places]
    comstr (substr intstr 1 (rem (strlen intstr) 3)); begin commified string w/ part before first comma [if any]
    intstr (substr intstr (1+ (strlen comstr)))
  ); setq
  (while (>= (strlen intstr) 3)
    (setq
      comstr (strcat comstr (if (> (strlen comstr) 0) "," "") (substr intstr 1 3)); [no comma if starts with 3 digits]
      intstr (substr intstr 4)
    ); setq
  ); while
  (strcat comstr decstr); add decimals back [if any]
)

 

Which gives such results as:

 

Command: (commify 284725.86572 3)
"284,725.866"

Command: (commify 1 0)
"1"

Command: (commify 234 4)
"234.0000"

Command: (commify 95738462.4 2)
"95,738,462.40"

Command: (commify pi 10)
"3.1415926536"

Command: (commify (* 123456 987675.43) 3)
"121,934,457,886.080"

Command: (commify (expt 2.5 😎 4)
"1,525.8789"

Kent Cooper, AIA
Message 11 of 16
GODOYFP
in reply to: Kent1Cooper

I had posted an OLD version. Did you see my new post/email?

Here it is again...

;;
;;Function to Add Thousand comma separator to any number
;;
;;By Felix P. Godoy 03/10/2004
;;
;;revs. 04/16/2005 Adds thosands comma separator to any number/ Clean up /
More efficient
;;
;; Numb = any number
;; Prec = precision
;;

(defun comma ( Numb Prec / lenNumb lenwhole decpos rBlock3 rBlock3c
rblock3cl Mode Number NumberList FinalNumber FoundE Found- wholelist
rwholelist wholeNumb rwholeNumb afterdec strNumb redFactor startn
commaNumber)

(setq lenNumb 0)
(setq lenwhole 0)
(setq decpos 0)
(setq rBlock3 nil)
(setq rBlock3cl nil)
(setq Mode (getvar "dimunit"))
(setq Number nil)
(setq FinalNumber nil)
(setq FoundE nil)
(setq Found- nil)
(setq NumberList nil)
(setq wholeList nil)
(setq rwholeList nil)

(setq strNumb (rtos Numb Mode Prec))
(setq FoundE (vl-string-search "E+" strnumb))
(setq Found- (vl-string-search "-" strnumb))
(setq decpos (vl-string-position 46 strNumb))
(if (null decpos)
(setq decpos 16)
)
(setq redFactor (- lenNumb decpos))
(setq wholeNumb (substr strNumb 1 decpos))
(setq afterdec (vl-string-left-trim WholeNumb strNumb))
(setq wholeList (vl-string->list wholeNumb))
(setq rwholeList (reverse wholeList))
(setq rwholeNumb (vl-list->string rwholeList))
(setq lenwhole (strlen wholeNumb))
(setq startn 1)
(if (or (<= lenwhole 3) (= FoundE T))
(setq commaNumber strNumb)
(progn
(while (/= "" rBlock3)
(setq rBlock3 (substr rwholenumb startn 3))
(setq rBlock3c (strcat rBlock3 ","))
(setq rBlock3cl (vl-string->list rBlock3c))
(if (/= rBlock3cl nil)
(setq NumberList (append (reverse rblock3cl) NumberList))
)
(setq Number (vl-list->string NumberList))
(if (= Found- 0)
(progn
(setq FinalNumber (vl-string-left-trim ",,-," Number))
(setq commaNumber (strcat "-" FinalNumber afterdec))
)
(progn
(setq FinalNumber (vl-string-left-trim ",," Number))
(setq commaNumber (strcat FinalNumber afterdec))
);this progn
);this if
(setq startn (+ startn 3))
(setq commaNumber commaNumber)
);while ends
);progn
);if
);defun

; Reverses a string
(defun revs ( string )
(vl-list->string (reverse (vl-string->list string)))
)


*** Enjoy !!! ***
Message 12 of 16
Kent1Cooper
in reply to: GODOYFP


@GODOYFP wrote:
I had posted an OLD version. Did you see my new post/email?
....

[Yes -- we obviously "crossed in the mail" with your latest and my editing my previous reply, q.v.]

Kent Cooper, AIA
Message 13 of 16
Lee_Mac
in reply to: Kent1Cooper

This looked like fun - here is my version:

 

(defun rtoc ( n p / d i l x )
    (setq d (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq l (vl-string->list (rtos n 2 p))
          x (cond ((cdr (member 46 (reverse l)))) ((reverse l)))
          i 0
    )
    (setvar 'dimzin d)
    (vl-list->string
        (append
            (reverse
                (apply 'append
                    (mapcar
                       '(lambda ( a b )
                            (if (and (zerop (rem (setq i (1+ i)) 3)) b)
                                (list a 44)
                                (list a)
                            )
                        )
                        x (append (cdr x) '(nil))
                    )
                )
            )
            (member 46 l)
        )
    )
)

 

@Kent, be careful when DIMZIN=8 Smiley Wink

Message 14 of 16
Lee_Mac
in reply to: Lee_Mac

Another to account for negatives:

 

(defun rtoc ( n p / d i l x )
    (setq d (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq l (vl-string->list (rtos (abs n) 2 p))
          x (cond ((cdr (member 46 (reverse l)))) ((reverse l)))
          i 0
    )
    (setvar 'dimzin d)
    (vl-list->string
        (append (if (minusp n) '(45))
            (reverse
                (apply 'append
                    (mapcar
                       '(lambda ( a b )
                            (if (and (zerop (rem (setq i (1+ i)) 3)) b)
                                (list a 44)
                                (list a)
                            )
                        )
                        x (append (cdr x) '(nil))
                    )
                )
            )
            (member 46 l)
        )
    )
)

 

And a recursive variation:

 

(defun rtoc ( n p / foo d l )
    (defun foo ( l n )
        (if (or (not (cadr l)) (= 46 (cadr l)))
            l
            (if (zerop (rem n 3))
                (vl-list* (car l) 44 (foo (cdr l) (1+ n)))
                (cons (car l) (foo (cdr l) (1+ n)))
            )
        )
    )
    (setq d (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq l (vl-string->list (rtos (abs n) 2 p)))
    (setvar 'dimzin d)
    (vl-list->string
        (append (if (minusp n) '(45))
            (foo l (- 3 (rem (fix (/ (log (abs n)) (log 10))) 3)))
        )
    )
)

 

Message 15 of 16
GODOYFP
in reply to: Lee_Mac

Nice... Very short.
Message 16 of 16
pbejse
in reply to: GODOYFP

Another

 

(defun _comma (n p / a b m i lst)
(setq dz (getvar 'dimzin))
(setvar 'Dimzin 0)  
(setq str (rtos (abs n) 2 p))
(setvar 'Dimzin dz)  
	(setq a	(vl-filename-base str)
	      b	(substr str (1+ (strlen a)))     
	      m	(vl-string->list a)
	      i	(length m) lst nil)
	(while (>= i 3)
	(setq lst (append (list 44
		   (nth (- i 3) m)
	           (nth (- i 2) m)
	           (nth (1- i) m)) lst ) i ( - i 3)) lst )
	(strcat (if (minusp n) "-" "")(substr str 1 i)  
		(vl-list->string (if (zerop i) (cdr lst) lst))
		b))

 [Not thorougly tested]

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost