topic Re: Change units of existing lisp in Visual LISP, AutoLISP and General Customization Forum

Change units of existing lisp

allebana13 — Thu, 22 Jul 2021 17:18:22 GMT

Hi everyone!
I have this routine from kimprojects, that sum up length of polylines and label as a text. Works very good but i need to change the units from meters to centimeters and i couldn't do it so far. Any helps?

(defun c:LPL (/ e ss l p i)
(if
(setq l 0.0 ss (ssget '((0 . "LINE,SPLINE,LWPOLYLINE,POLYLINE,ARC,CIRCLE,ELLIPSE"))))
(progn
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
l (+ l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
)
)
(if
(setq p (getpoint "\nSpecify a point to insert text: "))
(entmake
(list
'(0 . "TEXT")
'(100 . "AcDbText")
(cons 10 (trans p 1 0))
(cons 40 (/ 0.2 (getvar 'cannoscalevalue)))
(cons 1 (rtos l))
)
)
(princ (strcat "\nTotal length = " (rtos l)))
)
)
)
(princ)
)

Re: Change units of existing lisp

pbejse — Thu, 22 Jul 2021 17:29:02 GMT

@allebana13 wrote:

need to change the units from meters to centimeters and i couldn't do it so far. Any helps?

Add this line

...
)
(setq l (* 100 l))
(if
 (setq p (getpoint "\nSpecify a point to insert text: "))
  (entmake
...

Re: Change units of existing lisp

allebana13 — Thu, 22 Jul 2021 18:41:56 GMT

Thank you! it works perfectly.

Re: Change units of existing lisp

allebana13 — Thu, 22 Jul 2021 18:52:27 GMT

i have another question. How do i set the precision of the unit so that returns a non-decimal number?
If total lenght is 12.031, i want to get 12 instead.
Sorry for my bad english, I really appreciate your help.

Re: Change units of existing lisp

pbejse — Thu, 22 Jul 2021 19:06:48 GMT

Change (rtos l ) to (rtos l 2 0 )

Re: Change units of existing lisp

allebana13 — Fri, 23 Jul 2021 11:55:22 GMT

Hi! Thank you! I tried this and doesn't work, i keep getting a result with 4 decimal. What can be wrong?

(defun c:LPL (/ e ss l p i)
(if
(setq l 0.0 ss (ssget '((0 . "LINE,SPLINE,LWPOLYLINE,POLYLINE,ARC,CIRCLE,ELLIPSE"))))
(progn
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
l (+ l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
)
)
(setq l (* 100 l))
(if
(setq p (getpoint "\nSpecify a point to insert text: "))
(entmake
(list
'(0 . "TEXT")
'(100 . "AcDbText")
(cons 10 (trans p 1 0))
(cons 40 (/ 0.15 (getvar 'cannoscalevalue)))
(cons 1 (rtos l))
)
)
(princ (strcat "\nTotal length = " (rtos l 2 0)))
)
)
)
(princ)
)

Re: Change units of existing lisp

Kent1Cooper — Fri, 23 Jul 2021 12:09:17 GMT

You changed the prompt, but not also the part that sets the text content:

(cons 1 (rtos l))

should be

(cons 1 (rtos l 2 0))

Re: Change units of existing lisp

allebana13 — Fri, 23 Jul 2021 12:17:59 GMT

Thank you Kent! I'm very new at this.
Do you have any suggestions to start learning code language for be able to read and write lisp? I'm interested. Thank you.

Re: Change units of existing lisp

Kent1Cooper — Fri, 23 Jul 2021 16:03:50 GMT

@allebana13 wrote:

....
Do you have any suggestions to start learning code language for be able to read and write lisp? ....

Search this Forum for terms like "learn Lisp" or "learn AutoLisp" or "tutorial" or related wordings, and you will find a lot of suggestions for website links, videos, books, etc.

Re: Change units of existing lisp

suarez_residence — Fri, 28 Jun 2024 01:24:19 GMT

Hi everyone, how to change my unit from ' to m in my lisp

Re: Change units of existing lisp

suarez_residence — Fri, 28 Jun 2024 01:27:33 GMT

(DEFUN CHGD(OS / NS SL CT LT )
(SETQ NS "" SL (STRLEN OS) CT 1)
(WHILE (<= CT SL)
(SETQ LT (SUBSTR OS CT 1))
(IF (= LT "d")(SETQ LT "%%d"))
(SETQ CT (1+ CT) NS (STRCAT NS LT))))

(DEFUN C:BEARINGS( / P1 P2 P3 P4 DSTR DIST ASTR ANG TMP ENT LEN SS FLG KW1 TH KW )
(SETVAR "OSMODE" 0)
(SETVAR "ANGBASE" 0)
(SETVAR "CMDECHO" 0)
(command "style" "" "" 0.0 "" "" "" "" "" nil)
(PRINC "Note: ALL DISTANCES are from the X-Y PLANE\n")
(INITGET 1 "LR RL LL RR BL BR DL DR")
(SETQ KW (GETKWORD "LR RL LL RR BL BR DL DR: "))
(initget (+ 2 4))
(SETQ TH (GETDIST (strcat "TEXT HEIGHT <" (rtos (getvar "TEXTSIZE")) "> :")))
(if (= nil TH)(setq th (getvar "textsize")))
(INITGET 1 "Yes No")
(SETQ KW1 (GETKWORD "Reverse the Bearing Direction <Y>es <N>o: "))
(SETQ FLG 0)
(if (= KW1 "Yes")(progn
(IF (and(= KW "LR")(= FLG 0))(SETQ KW "RL" FLG 1))
(IF (and(= KW "RL")(= FLG 0))(SETQ KW "LR" FLG 1))
(IF (and(= KW "LL")(= FLG 0))(SETQ KW "RR" FLG 1))
(IF (and(= KW "RR")(= FLG 0))(SETQ KW "LL" FLG 1))
(IF (and(= KW "BL")(= FLG 0))(SETQ KW "BR" FLG 1))
(IF (and(= KW "BR")(= FLG 0))(SETQ KW "BL" FLG 1))
(IF (and(= KW "DL")(= FLG 0))(SETQ KW "DR" FLG 1))
(IF (and(= KW "DR")(= FLG 0))(SETQ KW "DL" FLG 1))
))
(SETVAR "TEXTSIZE" TH)
(SETQ SS (SSGET))
(SETQ LEN (SSLENGTH SS))
(SETVAR "HIGHLIGHT" 0)
(PRINC "WORKING...\n")
(REPEAT LEN
(SETQ LEN (1- LEN))
(SETQ ENT (SSNAME SS LEN))
(IF (/= "LINE" (CDR (ASSOC '0 (ENTGET ENT))))
(SSDEL ENT SS))
)
(SETQ LEN (SSLENGTH SS))
(REPEAT LEN
(SETQ LEN (1- LEN)
ENT (ENTGET (SSNAME SS LEN))
P1 (CDR (ASSOC '10 ENT))
P2 (CDR (ASSOC '11 ENT))
)
(IF (= KW1 "Yes")(SETQ TMP P2 P2 P1 P1 TMP))
(SETQ ANG (ANGLE P1 P2)
ASTR (CHGD (ANGTOS ANG 4 6))
DIST (DISTANCE P1 P2)
DSTR (RTOS DIST 2 3)
DSTR (STRCAT DSTR "\047")
P3 (POLAR P1 ANG (/ DIST 2.0))
P3 (POLAR P3 (+ ANG (/ PI 2.0))(* TH 1.125))
P4 (POLAR P1 ANG (/ DIST 2.0))
P4 (POLAR P4 (- ANG (/ PI 2.0))(* TH 1.125))
)
(IF (AND (> ANG (/ PI 2.0))(< ANG (* PI 1.5)))(SETQ ANG (- ANG PI)))
(SETQ ANG (ANGTOS ANG 0 8))
(IF (OR (= KW "DL") (= KW "DR"))(SETQ ASTR ""))
(IF (OR (= KW "BL")(= KW "BR"))(SETQ DSTR ""))
(IF (= ASTR "E")(SETQ ASTR "East"))
(IF (= ASTR "N")(SETQ ASTR "North"))
(IF (= ASTR "W")(SETQ ASTR "West"))
(IF (= ASTR "S")(SETQ ASTR "South"))
(IF (OR (= KW "LR")(= KW "BL")(= KW "DR"))(PROGN
(COMMAND "TEXT" "M" P3 "" ANG ASTR)
(COMMAND "TEXT" "M" P4 "" ANG DSTR)
)
)
(IF (= KW "LL") (PROGN
(SETQ ASTR (STRCAT ASTR " " DSTR))
(COMMAND "TEXT" "M" P3 "" ANG ASTR)
)
)
(IF (OR (= KW "RL")(= KW "BR")(= KW "DL")) (PROGN
(COMMAND "TEXT" "M" P4 "" ANG ASTR)
(COMMAND "TEXT" "M" P3 "" ANG DSTR)
)
)
(IF (= KW "RR") (PROGN
(SETQ ASTR (STRCAT ASTR " " DSTR))
(COMMAND "TEXT" "M" P4 "" ANG ASTR)
)
)
)
(SETVAR "HIGHLIGHT" 1)
(SETQ SS nil)(GC)
(SETVAR "FLATLAND" 0)
(PRINC "DONE")
(PRINC)
);close defun