topic Re: Modify this lisp please in Visual LISP, AutoLISP and General Customization Forum

Modify this lisp please

Philip-John — Sun, 20 Feb 2022 14:39:44 GMT

I got the following lisp to label 'Area' and 'Perimeter' of the selected closed polylines.

When running the lisp it asks "Select TEXT to match height". Somehow it's not working whereas I have to manually input the text height (... but it is ok).

Can someone modify the lisp to:

1. It should ask to "Select TEXT to match height OR enter text height"

2. The value selected or entered should be remembered till the file closes.

Please help..

(defun C:mynewarea (/ acsp adoc ar axss txht maxp minp obj p1 p2 pc1 pc2 per
ss txts txt1 txt2)

(vl-load-com)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
(setq acsp (vla-get-paperspace adoc))
(setq acsp (vla-get-modelspace adoc))
)
(vla-startundomark (vla-get-activedocument
(vlax-get-acad-object)))
(setQ txht (getreal "\nSelect TEXT to match height: "))
(setQ tx1 (/ txht 3))
(setQ tx2 (/ txht 1))

(prompt "\n Select OBJECTS on screen to add area label")

(if (setq ss (ssget))
(progn
(setq axss (vla-get-activeselectionset adoc))
(vlax-for obj axss
(if
(and
(not
(vl-catch-all-error-p
(setq
ar (vl-catch-all-apply
(function (lambda()
(vlax-curve-getarea obj)))))))
(not
(vl-catch-all-error-p
(setq
per (vl-catch-all-apply
(function (lambda()
(vlax-curve-getdistatparam obj
(vlax-curve-getendparam obj)))))))))

(progn
(setq txt2 (strcat "Area= " (rtos ar 2 2)))
(setq txt3 (strcat "Perimeter= " (rtos per 2 2)))

(setq pc1 (getpoint "\nPick Insertion point."))
(setq pc2 (mapcar '- pc1 (list 0 (* tx2 1.5) 0)))
(setq pc3 (mapcar '- pc2 (list 0 (* tx2 1.5) 0)))
;(setq pc4 (mapcar '- pc3 (list 0 (* tx2 1.5) 0)))

(command "text" pc2 tx2 "" txt2)
(command "text" pc3 tx2 "" txt3)
)
)
)
)
)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object)))
(princ)
)
(princ "\n Type mynewarea to label objects with area and perimeter text")
(princ)

Re: Modify this lisp please

hak_vz — Sun, 20 Feb 2022 15:01:16 GMT

(defun C:mynewarea (/ acsp adoc ar axss txht maxp minp obj p1 p2 pc1 pc2 per
ss txts txt1 txt2)

(vl-load-com)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
(setq acsp (vla-get-paperspace adoc))
(setq acsp (vla-get-modelspace adoc))
)
(vla-startundomark (vla-get-activedocument
(vlax-get-acad-object)))
(setQ txht (vlax-get (vlax-ename->vla-object(car (entsel "\nSelect TEXT to match height: "))) 'Height))

(prompt "\n Select OBJECTS on screen to add area label")

(progn
(setq txt2 (strcat "Area= " (rtos ar 2 2)))
(setq txt3 (strcat "Perimeter= " (rtos per 2 2)))

(setq pc1 (getpoint "\nPick Insertion point."))
(setq pc2 (mapcar '- pc1 (list 0 (* txht 1.5) 0)))
(setq pc3 (mapcar '- pc2 (list 0 (* txht 1.5) 0)))
;(setq pc4 (mapcar '- pc3 (list 0 (* txht 1.5) 0)))

(command "text" pc2 txht "" txt2)
(command "text" pc3 txht "" txt3)
)
)
)
)
)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object)))
(princ)
)
(princ "\n Type mynewarea to label objects with area and perimeter text")
(princ)

Re: Modify this lisp please

Philip-John — Sun, 20 Feb 2022 16:15:37 GMT

@hak_vz

Thanks..

Fine it's working.. But the text height should be keep remembered (in a variable) till I close the file.

I mean, the second time when I run the lisp it should keep the same text height 'if I hit enter button' against the prompt "Select TEXT to match height:".

Re: Modify this lisp please

hak_vz — Sun, 20 Feb 2022 16:34:46 GMT

Here is updated code that keeps text height after first selection.

I have also repaired some other errors.

(defun C:mynewarea (/ *error* acsp adoc ar axss maxp minp obj p1 p2 pc1 pc2 pc3 per ss txts txt2 txt3) (defun *error* ( msg ) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (if adoc (vla-endundomark adoc)) (princ) ) (vl-load-com) (setq adoc (vla-get-activedocument(vlax-get-acad-object))) (vla-endundomark adoc) (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1) ) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (vla-startundomark adoc) (if (not txht)(setQ txht (vlax-get (vlax-ename->vla-object(car (entsel "\nSelect TEXT to match height: "))) 'Height))) (prompt "\n Select OBJECTS on screen to add area label") (if (setq ss (ssget)) (progn (setq axss (vla-get-activeselectionset adoc)) (vlax-for obj axss (if (and (not (vl-catch-all-error-p (setq ar (vl-catch-all-apply (function (lambda() (vlax-curve-getarea obj))))))) (not (vl-catch-all-error-p (setq per (vl-catch-all-apply (function (lambda() (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))))))))) (progn (setq txt2 (strcat "Area= " (rtos ar 2 2))) (setq txt3 (strcat "Perimeter= " (rtos per 2 2))) (setq pc1 (getpoint "\nPick Insertion point.")) (setq pc2 (mapcar '- pc1 (list 0 (* txht 1.5) 0))) (setq pc3 (mapcar '- pc2 (list 0 (* txht 1.5) 0))) ;(setq pc4 (mapcar '- pc3 (list 0 (* txht 1.5) 0))) (command "text" pc2 txht "" txt2) (command "text" pc3 txht "" txt3) ) ) ) ) ) (vla-endundomark adoc) (princ) ) (princ "\n Type mynewarea to label objects with area and perimeter text") (princ)

If you need to change text height use following function

(defun C:mynewarea_text_height() (setQ txht (vlax-get (vlax-ename->vla-object(car (entsel "\nSelect TEXT to match height: "))) 'Height)) )

Re: Modify this lisp please

Philip-John — Sun, 20 Feb 2022 16:59:27 GMT

Thanks again @hak_vz .

Can you combine both part to one?

I mean; each time it should ask to "Select TEXT to match height" and if I hit 'Enter' button (without selecting any TEXT) the routine should use the previously selected height.

Thanks in advance.

Re: Modify this lisp please

hak_vz — Sun, 20 Feb 2022 17:55:05 GMT

I hope this is it.

(defun C:mynewarea (/ *error* m e acsp adoc ar axss maxp minp obj p1 p2 pc1 pc2 pc3 per ss txts txt2 txt3) (defun *error* ( msg ) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (if adoc (vla-endundomark adoc)) (setvar 'cmdecho 1) (princ) ) (defun set_text ( ) (setq e (car (entsel "\nSelect TEXT to match height: "))) (if e (setq m (vlax-get (vlax-ename->vla-object e) 'Height))) m ) (vl-load-com) (setq adoc (vla-get-activedocument(vlax-get-acad-object))) (vla-endundomark adoc) (if (and(= (getvar "tilemode") 0)(= (getvar "cvport") 1)) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (vla-startundomark adoc) (setq m (set_text)) (if (and m) (setq txht m)) (cond ((and txht) (prompt "\n Select OBJECTS on screen to add area label") (if (setq ss (ssget)) (progn (setq axss (vla-get-activeselectionset adoc)) (vlax-for obj axss (if (and (not (vl-catch-all-error-p (setq ar (vl-catch-all-apply (function (lambda() (vlax-curve-getarea obj))) ) ) ) ) (not (vl-catch-all-error-p (setq per (vl-catch-all-apply (function (lambda()(vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))) ) ) ) ) ) (progn (setvar 'cmdecho 0) (setq txt2 (strcat "Area= " (rtos ar 2 2)) txt3 (strcat "Perimeter= " (rtos per 2 2)) pc1 (getpoint "\nPick Insertion point.") pc2 (mapcar '- pc1 (list 0 (* txht 1.5) 0)) pc3 (mapcar '- pc2 (list 0 (* txht 1.5) 0)) ) (command "text" pc2 txht "" txt2) (command "text" pc3 txht "" txt3) (setvar 'cmdecho 1) ) ) ) ) ) ) (T (princ "\nYou ahould set inital text height. Start again!")) ) (vla-endundomark adoc) (princ "\nDOne!") (princ) ) (princ "\n Type mynewarea to label objects with area and perimeter text") (princ)

Re: Modify this lisp please

john.uhden — Mon, 21 Feb 2022 15:26:35 GMT

@Philip-John

Ah, the man with the interchangeable names (though not one of the Mamas and Papas).

While (initget 128) will allow keywords to entsel, that doesn't allow you to arbitrarily enter a numeric value to entsel, so I think you would have to do something like the following (not tested):

;; where *txht* can remain global for the current drawing. (if (not *txht*)(setq *txht* (getvar "textsize")) ;;| It's sort of an old convention among old lispers (of which I am one) to place * at both ends of an intentional global variable. |;; (or (and (setq e (car (entsel "\nSelect text for height or Enter to enter: "))) (setq obj (vlax-ename->vla-object e)) (vlax-property-available-p object 'Height) (setq *txht* (vlax-get obj 'Height)) ) (and (not (initget 6)) ; no zeros or negatives (setq ht (getdist (strcat "\nEnter text height <" (rtos *txht*) ">: "))) (setq *txht* ht) ) )

Re: Modify this lisp please

Sea-Haven — Mon, 21 Feb 2022 04:09:41 GMT

Global variables when in doubt I use AH:variablename then I know its mine. So JU:TXTHT could do GL:txtht

I dont like using * $ etc in variable names old DOS problems.

Re: Modify this lisp please

Philip-John — Mon, 21 Feb 2022 14:50:56 GMT

@hak_vz

Working perfectly.
If you don't mind, can you do a small modification also.
Presently first time I hit 'Enter' without selecting any text it shows the error "You should set initial text height. Start again!"

instead please modify as follows:

1. When I hit 'Enter' without selecting any text (for first time), it should prompt for "Enter new text height:".[ ]. And it should not move forward without getting a value unless I hit 'Esc'

2. When I hit 'Enter' without selecting any text (next time onwards), again it should prompt for "Enter new text height:".[1.5]. (here 1.5 is previously entered value OR previously selected text height).

Sorry for disturbing you again.

Regards..

Re: Modify this lisp please

john.uhden — Mon, 21 Feb 2022 15:28:16 GMT

@Philip-John

You could try my earlier offering again. It had a couple of my mistakes which I have now fixed.

Re: Modify this lisp please

Philip-John — Mon, 21 Feb 2022 15:43:25 GMT

Thnaks @john.uhden..

As a newbie I don't know where to insert your code or how to modify the code.

So if you could do it for me it shall be appreciated.

Re: Modify this lisp please

hak_vz — Mon, 21 Feb 2022 19:45:54 GMT

@Philip-John wrote:

@hak_vz

Working perfectly.
If you don't mind, can you do a small modification also.
Presently first time I hit 'Enter' without selecting any text it shows the error "You should set initial text height. Start again!"

instead please modify as follows:

1. When I hit 'Enter' without selecting any text (for first time), it should prompt for "Enter new text height:".[ ]. And it should not move forward without getting a value unless I hit 'Esc'

2. When I hit 'Enter' without selecting any text (next time onwards), again it should prompt for "Enter new text height:".[1.5]. (here 1.5 is previously entered value OR previously selected text height).

Sorry for disturbing you again.

Regards..

(setq txht 2.5) (defun C:mynewarea (/ *error* m e acsp adoc ar axss maxp minp obj p1 p2 pc1 pc2 pc3 per ss txts txt2 txt3) (defun *error* ( msg ) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (if adoc (vla-endundomark adoc)) (setvar 'cmdecho 1) (princ) ) (defun set_text ( tht) (if (and tht) (setq e (car (entsel (strcat "\nSelect TEXT to match height: <" (rtos tht 2 2) "> ")))) (setq e (car (entsel "\nSelect TEXT to match height: "))) ) (if e (setq m (vlax-get (vlax-ename->vla-object e) 'Height))) m ) (vl-load-com) (setq adoc (vla-get-activedocument(vlax-get-acad-object))) (vla-endundomark adoc) (if (and(= (getvar "tilemode") 0)(= (getvar "cvport") 1)) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (vla-startundomark adoc) (setq m (set_text txht)) (if (and m) (setq txht m)) (cond ((and txht) (prompt "\n Select OBJECTS on screen to add area label") (if (setq ss (ssget)) (progn (setq axss (vla-get-activeselectionset adoc)) (vlax-for obj axss (if (and (not (vl-catch-all-error-p (setq ar (vl-catch-all-apply (function (lambda() (vlax-curve-getarea obj))) ) ) ) ) (not (vl-catch-all-error-p (setq per (vl-catch-all-apply (function (lambda()(vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))) ) ) ) ) ) (progn (setvar 'cmdecho 0) (vla-highlight obj :vlax-true) (setq txt2 (strcat "Area= " (rtos ar 2 2)) txt3 (strcat "Perimeter= " (rtos per 2 2)) pc1 (getpoint "\nPick Insertion point.") pc2 (mapcar '- pc1 (list 0 (* txht 1.5) 0)) pc3 (mapcar '- pc2 (list 0 (* txht 1.5) 0)) ) (command "text" pc2 txht "" txt2) (command "text" pc3 txht "" txt3) (setvar 'cmdecho 1) (vla-highlight obj :vlax-false) ) ) ) ) ) ) (T (princ "\nEnter new text height by selecting text object!")) ) (vla-endundomark adoc) (princ "\nDone!") (princ) ) (princ "\n Type mynewarea to label objects with area and perimeter text") (princ)

I have modified your original code so it works how it does. It is supposed that you select some text entity to collect its height. I would do it by simply entering text value. If global value is not set it exits so that you don't receive error message, and it also informs you to make selection. Code is created the way this function usually work.

I have added option to sequentially highlight objects according to selection order so you don't have to remember it in case of large number of selected object.

I have set default value of text height to 2.5 in firs line

(setq txht 2.5)

Change it according to your needs.

Re: Modify this lisp please

john.uhden — Mon, 21 Feb 2022 16:44:48 GMT

@Philip-John

I suggest that if what @hak_vz has provided you works well enough, then use it.

If not, then I'm sure he would merge my code into his for you. A number of us work together around here to provide solutions.

But really, it's time for you to be learning this handy programming language to be able to help yourself.

Re: Modify this lisp please

Philip-John — Tue, 22 Feb 2022 05:20:05 GMT

Hi @hak_vz

Thanks for your lisp.

I need different text in different locations. So setting a default value is difficult for me.

I request you to modify your lisp to (if possible):

1. First time if I hit 'Enter' without selecting any match text height, it should prompt for "Specify Text height:". (see image below).

2. If I hit 'Enter' without selecting any match text height, it should prompt for "Specify Text height:" showing the previously selected height. (see image below).

Regards..

Re: Modify this lisp please

hak_vz — Tue, 22 Feb 2022 07:27:48 GMT

Try this

(setq txht (getvar 'textsize)) (defun C:mynewarea (/ *error* m e acsp adoc ar axss maxp minp obj p1 p2 pc1 pc2 pc3 per ss txts txt2 txt3) (defun *error* ( msg ) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (if adoc (vla-endundomark adoc)) (setvar 'cmdecho 1) (princ) ) (defun set_text ( tht) (if (and tht) (setq e (getreal(strcat "\nEnter text size: <" (rtos tht 2 2) "> "))) (setq e (getreal "\nEnter text size: ")) ) e ) (vl-load-com) (setq adoc (vla-get-activedocument(vlax-get-acad-object))) (vla-endundomark adoc) (if (and(= (getvar "tilemode") 0)(= (getvar "cvport") 1)) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (vla-startundomark adoc) (setq m (set_text txht)) (if (and m) (setq txht m)) (cond ((and txht) (prompt "\nSelect OBJECTS on screen to add area label") (if (setq ss (ssget)) (progn (setq axss (vla-get-activeselectionset adoc)) (vlax-for obj axss (if (and (not (vl-catch-all-error-p (setq ar (vl-catch-all-apply (function (lambda() (vlax-curve-getarea obj))) ) ) ) ) (not (vl-catch-all-error-p (setq per (vl-catch-all-apply (function (lambda()(vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))) ) ) ) ) ) (progn (setvar 'cmdecho 0) (vla-highlight obj :vlax-true) (setq txt2 (strcat "Area= " (rtos ar 2 2)) txt3 (strcat "Perimeter= " (rtos per 2 2)) pc1 (getpoint "\nPick Insertion point.") pc2 (mapcar '- pc1 (list 0 (* txht 1.5) 0)) pc3 (mapcar '- pc2 (list 0 (* txht 1.5) 0)) ) (command "text" pc2 txht "" txt2) (command "text" pc3 txht "" txt3) (setvar 'cmdecho 1) (vla-highlight obj :vlax-false) ) ) ) ) ) ) ) (vla-endundomark adoc) (princ "\nDone!") (princ) ) (princ "\n Type mynewarea to label objects with area and perimeter text") (princ)

Change input text how you like inside "\n "

Re: Modify this lisp please

Philip-John — Tue, 22 Feb 2022 10:09:57 GMT

Hi @hak_vz Thanks again..

Your last reply is same as what my first post do. I think you didn't get me completely.

Each time lisp should ask for "Select TEXT to match height" and keep remember selected text height value.

If I hit 'Enter' button without selecting any text then it should ask for "Specify text height" and what I specified should remember for next time

Re: Modify this lisp please

hak_vz — Tue, 22 Feb 2022 12:27:25 GMT

It is somehow unusual way of taking text height since you always have to pick some entity (and there is seldom need to change text sizes at every function repeat since it holds last value) but if you need it I hope this is it.

If you don't select text entity you are asked to enter text height (here you have to enter a value before continuation).

PS to exit function do not use ESC key since some object may stay highlighted.

(setq *txht* (getvar 'textsize)) (defun C:mynewarea (/ *error* m e acsp adoc ar axss maxp minp obj p1 p2 pc1 pc2 pc3 per ss txts txt2 txt3) (defun *error* ( msg ) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) (if adoc (vla-endundomark adoc)) (setvar 'cmdecho 1) (princ) ) (defun set_text (tht / e m) (setq e (car (entsel (strcat "\nSelect TEXT to match heigh <" (rtos tht 2 2) ">: ")))) (if e (setq m (vlax-get (vlax-ename->vla-object e) 'Height))) (initget (+ 1 2 4)) (if (not e)(setq m (getreal (strcat "\nSpecify TEXT height <" (rtos tht 2 2) ">: ")))) m ) (vl-load-com) (setq adoc (vla-get-activedocument(vlax-get-acad-object))) (vla-endundomark adoc) (if (and(= (getvar "tilemode") 0)(= (getvar "cvport") 1)) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (vla-startundomark adoc) (setq m (set_text *txht*)) (if (and m) (setq *txht* m)) (cond ((and *txht*) (prompt "\n Select OBJECTS on screen to add area label") (if (setq ss (ssget)) (progn (setq axss (vla-get-activeselectionset adoc)) (vlax-for obj axss (if (and (not (vl-catch-all-error-p (setq ar (vl-catch-all-apply (function (lambda() (vlax-curve-getarea obj))) ) ) ) ) (not (vl-catch-all-error-p (setq per (vl-catch-all-apply (function (lambda()(vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))) ) ) ) ) ) (progn (setvar 'cmdecho 0) (vla-highlight obj :vlax-true) (setq txt2 (strcat "Area= " (rtos ar 2 2)) txt3 (strcat "Perimeter= " (rtos per 2 2)) pc1 (getpoint "\nPick Insertion point.") pc2 (mapcar '- pc1 (list 0 (* *txht* 1.5) 0)) pc3 (mapcar '- pc2 (list 0 (* *txht* 1.5) 0)) ) (command "text" pc2 *txht* "" txt2) (command "text" pc3 *txht* "" txt3) (setvar 'cmdecho 1) (vla-highlight obj :vlax-false) ) ) ) ) ) ) (T (princ "\nEnter new text height by selecting text object!")) ) (vla-endundomark adoc) (princ "\nDone!") (princ) ) (princ "\n Type mynewarea to label objects with area and perimeter text") (princ)

Re: Modify this lisp please

Philip-John — Fri, 25 Feb 2022 07:53:03 GMT

hi @hak_vz ,

Thanks again...

Everything working fine as expected

But it shows an error when I hit 'Enter' button to accept the previous vale. (see below video)

Re: Modify this lisp please

hak_vz — Fri, 25 Feb 2022 11:36:31 GMT

@Philip-John wrote:

hi @hak_vz ,

Thanks again...

Everything working fine as expected

But it shows an error when I hit 'Enter' button to accept the previous vale. (see below video)

I have tested code in any possible situation and it works as expected. Maybe it is not written the way I would do it myself, but since I took your code for modification it is fixed to some reasonable extent.

What you receive is a expected result. Function initget is stopping you to continue code execution as long as you don't have predefined text height (either by selection or entering). Code prevents you to hit enter in that case and asks you to define it. Global variable that holds text size is set to nil i.e. it is not initialized.

Save your code in separate file with extension .lst and assure that first line above the code is added to that file.

(setq *txth* 2.5) - see the original code. For a first run you really need some value of text height to start with.

Once you start learning autolisp (any CAD user should know at least the basics) and writing your code you will understand what I'm talking about.

PS. Be regular with your responses (check forum regularly). When I see green circle on for two days and see no reply from OP I generally lose interest for that request. This all could have been resolved in one or two days.

Re: Modify this lisp please

Philip-John — Fri, 25 Feb 2022 13:02:12 GMT

Thanks @hak_vz.

Take your own time..

God bless..