Russello Posted March 20, 2018 Share Posted March 20, 2018 Hello everyone! I have a lisp routine here that computes and displays the area of a polygon. My problem is it shows no comma for areas above 999. Can someone help me how to improve this lisp routine? Thanks in advance. (defun c:LAR ( / sz o1 ipt opp parea h) (while (setq clyer(getvar"clayer")) (command "layer" "m" "Boundary for Area" "") (command "layer" "c" "4" "Boundary for Area" "") (command "layer" "p" "n" "Boundary for Area" "") (command "color" "bylayer") (setq ipt (getpoint "\n Select Internal Point of Lot: ")) (command "-Boundary" ipt"" "") (setq o1 (entlast)) (redraw o1 3) (command "area" "O" "L") (setq opp (getvar "area")) (initget 1) (setq parea(getpoint"\n Select insertion point")) (command "layer" "m" "Area Text" "") (command "layer" "c" "81" "Area Text" "") (command "color" "bylayer") (initget 1) (command "regen") (command "text" parea "" (strcat "A=" (rtos opp 2 0) " Sq.m.")) (setvar"clayer"clyer) ) ) Quote Link to comment Share on other sites More sharing options...
kpblc Posted March 20, 2018 Share Posted March 20, 2018 Check this: (vl-load-com) (defun c:lar (/ sz o1 ipt opp parea h adoc _kpblc-eval-value-round) (defun _kpblc-eval-value-round (value to) ;| ;; http://forum.dwg.ru/showthread.php?p=301275 |; (if (zerop to) value (* (atoi (rtos (/ (float value) to) 2 0)) to) ) ;_ end of if ) ;_ end of defun (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (while (setq clyer (getvar "clayer")) (vla-startundomark adoc) (command "_.-layer" "_m" "Boundary for Area" "") (command "_.-layer" "_c" "4" "Boundary for Area" "") (command "_.-layer" "_p" "n" "Boundary for Area" "") (command "_.color" "bylayer") (setq ipt (getpoint "\n Select Internal Point of Lot: ")) (command "_.-Boundary" ipt "" "") (setq o1 (entlast)) (redraw o1 3) (command "_.area" "_O" "_L") (setq opp (getvar "area")) (initget 1) (setq parea (getpoint "\n Select insertion point")) (command "_.-layer" "_m" "Area Text" "") (command "_.-layer" "_c" "81" "Area Text" "") (command "_.-color" "bylayer") (initget 1) (command "_.regen") (command "_.text" parea "" (strcat "A=" (itoa (_kpblc-eval-value-round opp 1)) " Sq.m.")) (setvar "clayer" clyer) (vla-endundomark adoc) ) ;_ end of while (princ) ) ;_ end of defun Quote Link to comment Share on other sites More sharing options...
BIGAL Posted March 20, 2018 Share Posted March 20, 2018 2nd check this no need to exit layer command til all done. (command "_.-layer" "_m" "Boundary for Area" "_c" "4" "Boundary for Area" "_p" "n" "Boundary for Area" "") ) Quote Link to comment Share on other sites More sharing options...
kpblc Posted March 20, 2018 Share Posted March 20, 2018 Actually I don't like to use command methods. So because of this I don't know full command syntax Quote Link to comment Share on other sites More sharing options...
Russello Posted March 20, 2018 Author Share Posted March 20, 2018 Thanks for your insights sir BIGAL and kpblc. I tried running the routine and still there is no comma separator when the values are in thousands. I don't know how or do I need to edit the lisp routine sir kpblc posted? thanks again masters Quote Link to comment Share on other sites More sharing options...
kpblc Posted March 20, 2018 Share Posted March 20, 2018 (defun _kpblc-string-append-sep (string separator range / fun_conv-list-to-sublst lst count) ;| (_kpblc-string-append-sep "123456789" "," 2) ; (_kpblc-string-append-sep "123456789" "," 3) ; "123,456,789" (_kpblc-string-append-sep "1234567890123456789" "," 10) ; "123456789,0123456789" (_kpblc-string-append-sep "123456789" "'" 3) ; "123'456'789" |; (defun fun_conv-list-to-sublst (lst range / res) (cond ((not lst) nil) ((and lst (< (length lst) range)) (setq res (list lst))) (t (setq res (cons ((lambda (/ i _r) (setq i 0) (while (< i range) (setq _r (cons (car lst) _r) lst (cdr lst) i (1+ i) ) ;_ end of setq ) ;_ end of while (reverse _r) ) ;_ end of LAMBDA ) (fun_conv-list-to-sublst lst range) ) ;_ end of cons ) ;_ end of setq ) ) ;_ end of cond res ) ;_ end of defun ;_ end of defun (setq lst (mapcar 'vl-list->string (reverse (mapcar 'reverse (fun_conv-list-to-sublst (reverse (vl-string->list string)) range))) ) ;_ end of mapcar ) ;_ end of setq (if (< (length lst) 2) (car lst) (strcat (car lst) (apply 'strcat (mapcar '(lambda (x) (strcat separator x)) (cdr lst)))) ) ;_ end of if ) ;_ end of defun Quote Link to comment Share on other sites More sharing options...
rlx Posted March 20, 2018 Share Posted March 20, 2018 here's my lunch : ;; Insert Nth - Lee Mac ;; Inserts an item at the nth position in a list. ;; x - [any] Item to be inserted ;; n - [int] Zero-based index at which to insert item ;; l - [lst] List in which item is to be inserted (defun LM:insertnth ( x n l )(cond ((null l) nil)((< 0 n) (cons (car l) (LM:insertnth x (1- n) (cdr l))))((cons x l)))) (defun tst ( / n str lst) (setq str "12345678901234567890" n 3 lst (reverse (vl-string->list str))) (while (< n (length lst)) (setq lst (LM:insertnth (ascii ",") n lst) n (+ n 4))) (vl-list->string (reverse lst)) ) $ (tst) -> "12,345,678,901,234,567,890" gr. Rlx Quote Link to comment Share on other sites More sharing options...
Russello Posted March 20, 2018 Author Share Posted March 20, 2018 Thanks sir kpblc and rlx. I finally got it. I found sir Lee Mac's post and try experimenting it with my routine. Here is my new lisp routine. Again thank you everyone for your insights and help. (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) ) ) ) (defun c:LARR ( / sz o1 ipt opp oppp parea h) (while (setq clyer(getvar"clayer")) (command "_.-layer" "_m" "Boundary for Area" "_c" "4" "Boundary for Area" "_p" "n" "Boundary for Area" "") (command "color" "bylayer") (setq ipt (getpoint "\n Select Internal Point of Lot: ")) (command "-Boundary" ipt"" "") (setq o1 (entlast)) (redraw o1 3) (command "area" "O" "L") (setq opp (getvar "area")) (initget 1) (setq parea(getpoint"\n Select insertion point")) (command "layer" "m" "Area Text" "") (command "layer" "c" "81" "Area Text" "") (command "color" "bylayer") (initget 1) (command "regen") (setq oppp (rtoc opp 0)) (command "text" parea "" (strcat "A=" oppp " Sq.m.")) (setvar"clayer"clyer) ) ) http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/1-000-Comma-Separator/m-p/5015892#M322341 CHEERS! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.