Lisp to run a calculation

August 12, 2020

Hello all,

I'm looking for a lisp routine to run a calculation when I click on a text number in my cad file. What I need it for is this: I do irrigation plans. I have a lisp that gives me the square footage of an area when I click on it and then I can place the text showing the square footage. I would love to have a lisp that when I click on that number it runs a calculation and gives me an area. Currently I have a formula in excel that I can put in the square footage and then it runs the number based on the formula. It works and it isn't bad for small irrigation plans. However for large ones it takes forever. The formula I would need is the following: the number I click on x 18 x 12 x .77 / 60 This will give me gallonage of the area in gallons per minute with an 18" row spacing, 12" emitter spacing on each row and .77 gallon per hour emitters converted to gallons per minute.

Does such a lisp exist?

Thanks in advance.

August 13, 2020

Ho @jpruessner, for better understand, please upload both the dwg and lisp .

So it can be easy to suit your need.

August 14, 2020

A quicky as example dont know what you want to do with answer. make sure download Multi getvals.lsp

(defun c:test ( / ans row emit gal ans2 ent)
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))

(setq ans (AH:getvalsm (list "Enter values" "Rows" 5 4 "18" "Emitter" 5 4 "12" "Gallons" 5 4 "0.77")))
(setq row (atof (nth 0 ans)))
(setq emit (atof (nth 1 ans)))
(setq gal (atof (nth 2 ans)))

(while (setq ent (entsel "\nPick area txt press Enter to exit"))
	(setq txt (atof (cdr (assoc 1 (entget (car ent))))))
	(setq ans2 (rtos (/ (* row emit gal txt) 60.0) 2 3))
	(alert (strcat (rtos row 2 1) " " (rtos emit 2 1) " " (rtos gal 2 2) " " ans2))
)

(princ)

)
(c:test)

Multi GETVALS.lsp

August 14, 2020

Text Calculator

August 14, 2020

On 8/12/2020 at 9:48 AM, jpruessner said:

Hello all,

I'm looking for a lisp routine to run a calculation when I click on a text number in my cad file. What I need it for is this: I do irrigation plans. I have a lisp that gives me the square footage of an area when I click on it and then I can place the text showing the square footage. I would love to have a lisp that when I click on that number it runs a calculation and gives me an area. Currently I have a formula in excel that I can put in the square footage and then it runs the number based on the formula. It works and it isn't bad for small irrigation plans. However for large ones it takes forever. The formula I would need is the following: the number I click on x 18 x 12 x .77 / 60 This will give me gallonage of the area in gallons per minute with an 18" row spacing, 12" emitter spacing on each row and .77 gallon per hour emitters converted to gallons per minute.

Does such a lisp exist?

Thanks in advance.

I do irrigation design as well and this was something I wrote about 14 years ago for a Netafim job. Let me take a look in the morning and I'll tidy this up. It will accept emitter spacing, spacing between rows and emitter flow so it's a bit more generic.

August 17, 2020

On 8/13/2020 at 11:05 PM, ronjonp said:

I do irrigation design as well and this was something I wrote about 14 years ago for a Netafim job. Let me take a look in the morning and I'll tidy this up. It will accept emitter spacing, spacing between rows and emitter flow so it's a bit more generic.

That would be awesome if you could help out on this! Thank you.

August 17, 2020

On 8/13/2020 at 7:06 PM, BIGAL said:

A quicky as example dont know what you want to do with answer. make sure download Multi getvals.lsp


(defun c:test ( / ans row emit gal ans2 ent)
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))

(setq ans (AH:getvalsm (list "Enter values" "Rows" 5 4 "18" "Emitter" 5 4 "12" "Gallons" 5 4 "0.77")))
(setq row (atof (nth 0 ans)))
(setq emit (atof (nth 1 ans)))
(setq gal (atof (nth 2 ans)))

(while (setq ent (entsel "\nPick area txt press Enter to exit"))
	(setq txt (atof (cdr (assoc 1 (entget (car ent))))))
	(setq ans2 (rtos (/ (* row emit gal txt) 60.0) 2 3))
	(alert (strcat (rtos row 2 1) " " (rtos emit 2 1) " " (rtos gal 2 2) " " ans2))
)

(princ)

)
(c:test)

Multi GETVALS.lsp 2.07 kB · 45 downloads

So I create a lisp from this code? I'm totally new to this other than just using them. I'll need the other "multi getvals.lsp" lisp in order to run this one?

August 17, 2020

On 8/13/2020 at 10:20 PM, Jonathan Handojo said:

Text Calculator

I've used this before and while it works, I may as well just use a calculator. I want a lisp where the values are already created because those remain constant other than the square footage shown in a number format.

August 17, 2020

5 hours ago, jpruessner said:

That would be awesome if you could help out on this! Thank you.

Sorry for the delay .. got a bit busy and needed to rewrite most of that other code ... please double check the numbers!

(defun c:ild (/ a flg p s)
  ;; RJP » 2020-08-17
  (or *emspc* (setq *emspc* 18.))
  (or *rowspc* (setq *rowspc* 12.))
  (or *eflow* (setq *eflow* 0.77))
  (setq	*emspc*
	 (cond
	   ((getint (strcat "\nEnter emitter spacing in tubing (inches):<" (rtos *emspc* 2 1) ">")
	    )
	   )
	   (*emspc*)
	 )
  )
  (setq	*rowspc*
	 (cond
	   ((getint (strcat "\nEnter spacing between rows (inches):<" (rtos *rowspc* 2 1) ">"))
	   )
	   (*rowspc*)
	 )
  )
  (setq	*eflow*	(cond ((getint (strcat "\nEnter emitter flow (gph):<" (rtos *eflow* 2 2) ">")))
		      (*eflow*)
		)
  )
  (setq flg (> (getvar 'lunits) 2))
  (if (setq s (ssget '((0 . "*POLYLINE,CIRCLE,REGION,ELLIPSE,SPLINE"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (redraw e 3)
      (setq a (vlax-curve-getarea e))
      ;; This portion could be updated to insert the text in the center of the bounding box if you'd like ( no picking required )
      (if (setq p (getpoint "\nPick a point to place text: "))
	(entmake (list '(0 . "MTEXT")
		       '(100 . "AcDbEntity")
		       '(67 . 0)
		       '(8 . "InlineDripNumbers")
		       '(100 . "AcDbMText")
		       (cons 10 p)
		       ;; Adjust text height here
		       (cons 40 (getvar 'textsize))
		       '(71 . 5)
		       (cons 1
			     (strcat "AREA (SQ FT): "
				     (rtos a (getvar 'lunits) 2)
				     "\\PFLOW (GPM): "
				     (rtos (* (/ (* a
						    (if	flg
						      1.
						      144.
						    )
						 )
						 (* *emspc* *rowspc*)
					      )
					      (/ *eflow* 60.)
					   )
					   2
					   2
				     )
			     )
		       )
		       '(11 1. 0. 0.)
		       '(43 . 0.125)
		       '(50 . 0.)
		 )
	)
      )
      (redraw e 4)
    )
  )
  (princ)
)
(vl-load-com)

August 18, 2020

A purpose written code to match the task is always best, nice Ronjonp.

August 18, 2020

1 hour ago, BIGAL said:

A purpose written code to match the task is always best, nice Ronjonp.

Thanks

August 27, 2020

On 8/17/2020 at 10:18 PM, ronjonp said:

Sorry for the delay .. got a bit busy and needed to rewrite most of that other code ... please double check the numbers!


(defun c:ild (/ a flg p s)
  ;; RJP » 2020-08-17
  (or *emspc* (setq *emspc* 18.))
  (or *rowspc* (setq *rowspc* 12.))
  (or *eflow* (setq *eflow* 0.77))
  (setq	*emspc*
	 (cond
	   ((getint (strcat "\nEnter emitter spacing in tubing (inches):<" (rtos *emspc* 2 1) ">")
	    )
	   )
	   (*emspc*)
	 )
  )
  (setq	*rowspc*
	 (cond
	   ((getint (strcat "\nEnter spacing between rows (inches):<" (rtos *rowspc* 2 1) ">"))
	   )
	   (*rowspc*)
	 )
  )
  (setq	*eflow*	(cond ((getint (strcat "\nEnter emitter flow (gph):<" (rtos *eflow* 2 2) ">")))
		      (*eflow*)
		)
  )
  (setq flg (> (getvar 'lunits) 2))
  (if (setq s (ssget '((0 . "*POLYLINE,CIRCLE,REGION,ELLIPSE,SPLINE"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (redraw e 3)
      (setq a (vlax-curve-getarea e))
      ;; This portion could be updated to insert the text in the center of the bounding box if you'd like ( no picking required )
      (if (setq p (getpoint "\nPick a point to place text: "))
	(entmake (list '(0 . "MTEXT")
		       '(100 . "AcDbEntity")
		       '(67 . 0)
		       '(8 . "InlineDripNumbers")
		       '(100 . "AcDbMText")
		       (cons 10 p)
		       ;; Adjust text height here
		       (cons 40 (getvar 'textsize))
		       '(71 . 5)
		       (cons 1
			     (strcat "AREA (SQ FT): "
				     (rtos a (getvar 'lunits) 2)
				     "\\PFLOW (GPM): "
				     (rtos (* (/ (* a
						    (if	flg
						      1.
						      144.
						    )
						 )
						 (* *emspc* *rowspc*)
					      )
					      (/ *eflow* 60.)
					   )
					   2
					   2
				     )
			     )
		       )
		       '(11 1. 0. 0.)
		       '(43 . 0.125)
		       '(50 . 0.)
		 )
	)
      )
      (redraw e 4)
    )
  )
  (princ)
)
(vl-load-com)

hello ronjonp , sounds u are really expert in lisp functions , may u help me please to adjust this lisp which works to sum text numbers and place the result in new text that works well but i wanna add another job to it, to delete the summed texts ...thanks in advance

addandtext.lsp

August 28, 2020

delete summed text ??

Why not just delete, please explain more.

August 29, 2020

10 hours ago, BIGAL said:

delete summed text ??

Why not just delete, please explain more.

hello bigal,

i just want to delete the texts which are selected and added together ..as an example, i have texts as 1,2, 4, 5 so i select 2,5,1 then the lisp should calculate the sum of these texts and ask me for location of new text with the sum ...the attached lisp doing this very well but i wanted another option in it to delete the texts 1, 2, 5 which are already summed in the new text .. i hope u got me now

August 29, 2020

Try this oldie of mine, updated to delete the picked texts. This only works with "TEXT" and not "MTEXT". Total text is in layer and style of first selected text.

(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun

(vl-load-com)

(defun c:t+ ( / *error* ent elst el num tot nlst sel pt txt)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_defun

  (while (not tot)
    (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : ")))))
    (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (cdr (assoc 1 el)))) (cond ( (zerop num) (setq tot nil) (alert "Text Entity NOT a number")) (t (setq tot num))))
          (t (alert "Not a Text Entity"))
    );end_cond
    (cond (num (setq nlst (cons ent nlst))))
  );end_while

  (while (setq sel (entsel "\nSelect Next Text Number Entity : "))
    (setq elst (entget (setq ent (car sel))))
    (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (cdr (assoc 1 elst)))) (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number"))))
          (t (alert "Not a Text Entity"))
    );end_cond
    (if num (setq tot (+ tot num) nlst (cons ent nlst)))
  );end_while

  (cond (tot
          (setq pt (getpoint "\nSelect Total Insertion Point : ")
                txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))
          );end_setq
          (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)))
          (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o)))
        )
  );end_cond

  (princ)
);end_defun

August 29, 2020

6 hours ago, dlanorh said:

Try this oldie of mine, updated to delete the picked texts. This only works with "TEXT" and not "MTEXT". Total text is in layer and style of first selected text.


(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun

(vl-load-com)

(defun c:t+ ( / *error* ent elst el num tot nlst sel pt txt)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_defun

  (while (not tot)
    (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : ")))))
    (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (cdr (assoc 1 el)))) (cond ( (zerop num) (setq tot nil) (alert "Text Entity NOT a number")) (t (setq tot num))))
          (t (alert "Not a Text Entity"))
    );end_cond
    (cond (num (setq nlst (cons ent nlst))))
  );end_while

  (while (setq sel (entsel "\nSelect Next Text Number Entity : "))
    (setq elst (entget (setq ent (car sel))))
    (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (cdr (assoc 1 elst)))) (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number"))))
          (t (alert "Not a Text Entity"))
    );end_cond
    (if num (setq tot (+ tot num) nlst (cons ent nlst)))
  );end_while

  (cond (tot
          (setq pt (getpoint "\nSelect Total Insertion Point : ")
                txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))
          );end_setq
          (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)))
          (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o)))
        )
  );end_cond

  (princ)
);end_defun

woooow ... thanks much dlanorh ... i appreciate ur help , it works well with me ... but what i can do to make it working with mtexts too !!

August 29, 2020

50 minutes ago, shadi said:

woooow ... thanks much dlanorh ... i appreciate ur help , it works well with me ... but what i can do to make it working with mtexts too !!

Try this minor modification. This now works with TEXT and MTEXT provided the TEXT or MTEXT are just integers or reals (Not a mix of alphanumeric characters). It ignores any MTEXT formatting. If a MTEXT text is the first text selected, the inserted TEXT total will be in the mtext style but have a default text width.

(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun

(vl-load-com)

(defun c:t+ ( / *error* ent elst el num tot nlst sel pt txt)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_defun

  (while (not tot)
    (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : ")))))
    (cond ( (wcmatch (cdr (assoc 0 el)) "*TEXT")
            (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString"))))
                  (t (setq num (atof (getpropertyvalue ent "Text"))))
            );end_cond
            (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")) (t (setq tot num)))
          )
          (t (alert "Not a Text Entity"))
    );end_cond
    (cond (num (setq nlst (cons ent nlst))))
  );end_while

  (while (setq sel (entsel "\nSelect Next Text Number Entity : "))
    (setq elst (entget (setq ent (car sel))))
    (cond ( (wcmatch (cdr (assoc 0 elst)) "*TEXT")
            (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString"))))
                  (t (setq num (atof (getpropertyvalue ent "Text"))))
            );end_cond
            (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")))
          )
          (t (alert "Not a Text Entity"))
    );end_cond
    (if num (setq tot (+ tot num) nlst (cons ent nlst)))
  );end_while

  (cond (tot
          (setq pt (getpoint "\nSelect Total Insertion Point : ")
                txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))
          );end_setq
          (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)))
          (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o)))
        )
  );end_cond

  (princ)
);end_defun

August 29, 2020

2 hours ago, dlanorh said:

Try this minor modification. This now works with TEXT and MTEXT provided the TEXT or MTEXT are just integers or reals (Not a mix of alphanumeric characters). It ignores any MTEXT formatting. If a MTEXT text is the first text selected, the inserted TEXT total will be in the mtext style but have a default text width.


(defun rh:em_txt ( pt txt lyr sty tht xsf)
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
                  (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf))
            );end_list
  );end_entmakex
);end_defun

(vl-load-com)

(defun c:t+ ( / *error* ent elst el num tot nlst sel pt txt)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_defun

  (while (not tot)
    (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : ")))))
    (cond ( (wcmatch (cdr (assoc 0 el)) "*TEXT")
            (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString"))))
                  (t (setq num (atof (getpropertyvalue ent "Text"))))
            );end_cond
            (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")) (t (setq tot num)))
          )
          (t (alert "Not a Text Entity"))
    );end_cond
    (cond (num (setq nlst (cons ent nlst))))
  );end_while

  (while (setq sel (entsel "\nSelect Next Text Number Entity : "))
    (setq elst (entget (setq ent (car sel))))
    (cond ( (wcmatch (cdr (assoc 0 elst)) "*TEXT")
            (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString"))))
                  (t (setq num (atof (getpropertyvalue ent "Text"))))
            );end_cond
            (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")))
          )
          (t (alert "Not a Text Entity"))
    );end_cond
    (if num (setq tot (+ tot num) nlst (cons ent nlst)))
  );end_while

  (cond (tot
          (setq pt (getpoint "\nSelect Total Insertion Point : ")
                txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))
          );end_setq
          (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)))
          (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o)))
        )
  );end_cond

  (princ)
);end_defun

nice try , thanks much for ur try to help me .. but i see the result text (just in case of summing mtexts) is with strange text style like in the attached photo .. may u can fix that ? .. and may please another option to this lisp to mark selected texts or dont let me select text twice so it will just be calculated once

August 30, 2020

8 hours ago, shadi said:

nice try , thanks much for ur try to help me .. but i see the result text (just in case of summing mtexts) is with strange text style like in the attached photo .. may u can fix that ? .. and may please another option to this lisp to mark selected texts or dont let me select text twice so it will just be calculated once

I have no idea why it is doing this. Save this as a sample.dwg in AutoCAD 2012 format and attach it to a post so I have something to test against and find out why this is happening. I think this could be a ucs problem.

August 30, 2020

2 hours ago, dlanorh said:

I have no idea why it is doing this. Save this as a sample.dwg in AutoCAD 2012 format and attach it to a post so I have something to test against and find out why this is happening. I think this could be a ucs problem.

good afternoon there , here is the cad file saved in earlier version than 2012 .. , that problem just appeared in mtext summing , not with texts .. anyway , the most important to me is not to select text twice because really i could forget which one i select and that will affect the result ... thank u once again for ur care

cad.dwg

Lisp to run a calculation

Recommended Posts

jpruessner

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp

dlanorh

dlanorh

Posted Images

devitg

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Jonathan Handojo

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

jpruessner

Link to comment

Share on other sites

jpruessner

Link to comment

Share on other sites

jpruessner

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

shadi

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

shadi

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

shadi

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

shadi

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

shadi

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity