Lisp to divide total selected dimensions by given amount

Lisp to divide total selected dimensions by given amount

paul9ZMBV
Advocate Advocate
745 Views
8 Replies
Message 1 of 9

Lisp to divide total selected dimensions by given amount

paul9ZMBV
Advocate
Advocate

Hi,

I have a lisp below which can total the selected dimensions, but I would like to add the following feature, after the total is shown the user has the option to divide the total by the inputted amount and display that amount.

 

It would also be nice to have the dimensions turn blue (as in selected) when selecting each dimension as currently you cant visibly see which dims are selected.

 

Any help much appreciated

 

;;;=======================[ Length.lsp ]=========================
;;; Author: Copyright© 2005-2008 Charles Alan Butler
;;; Version: 1.1 Mar. 04,2008
;;; Purpose: display the length of a selected objects
;;; and a running total, objects supported:
;;; LINE, LWPOLYLINE, POLYLINE, SPLINE, ARC, CIRCLE, DIMENSION
;;; Sub_Routines: put_txt add text to dwg
;;; Returns: -NA
;;;==============================================================
;|
I know there are many fine "Length" routines around.
This is my version and it allows the user to pick each object & displays
the length & a running total on the command line.
An option at start up lets the user optionally put the result in the drawing.
The text is placed at the user pick point and the current text style & layer are used.
The options for text insert are:
None - No text is inserted, this is the default
Each - Text is inserted after each object is selected
Total - Text is inserted only at the end of all selections & only the total is inserted.

Exit the routine by pressing Enter or picking nothing
Pressing C enter will clear the total
Pressing U enter will remove the last object
Pressing Enter while placing the text will skip the insert for that object.
|;
(defun c:length (/ en len pt txt ent_allowed total_len typ obj usercmd LenList NewTxt)
(vl-load-com)
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(defun put_txt (txt / pt)
;; Check if the drawing height is set to 0:
(if (setq pt (getpoint "\nPick Text Location..."))
(progn
(if (= 0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
(command "text" "non" pt "" "0" txt)
(command "text" "non" pt "0" txt)
)
(entlast) ; return ename
)
(prompt "\n*** Text Insert skipped ***")
)
)

(initget "Each Total None" )
(setq txt_opt (getkword "\nPut text in drawing for [Each/Total/None]. <None>"))
(or txt_opt (setq txt_opt "None"))


(setq ent_allowed '("LINE" "LWPOLYLINE" "POLYLINE" "SPLINE" "ARC" "CIRCLE" "DIMENSION")
total_len 0
)
(while (or (initget "Clear Undo")
(setq en (entsel "\nPick object for length, [Clear/Undo]."))
)
(cond
((= "Clear" en)
(if (member txt_opt '("Each" "Total"))
(put_txt (strcat "Total " (rtos total_len)))
)
(setq total_len 0 ; clear length total
LenList nil)
)
((= "Undo" en)
(if LenList
(progn
(setq total_len (- total_len (cadar LenList)))
(princ (strcat "\n** Removed " (caar LenList) " length = "
(rtos (cadar LenList)) " Running total is " (rtos total_len)))
(if (caddar LenList) (entdel (caddar LenList)))
(setq LenList (cdr LenList))
)
(prompt "\n** No more Undo possible.")
)
)
(t
(setq en (car en)
obj (vlax-ename->vla-object en)
)
(if (member (setq typ (cdr (assoc 0 (entget en)))) ent_allowed)
(progn
(cond
((vlax-property-available-p obj 'Measurement)
(setq len (vla-get-measurement obj))
)
((setq len (vlax-curve-getdistatparam en (vlax-curve-getendparam en))))
)
(setq total_len (+ len total_len))
(princ (strcat "\n" typ " length = " (rtos len)
" Running total is " (rtos total_len)))
(if (= txt_opt "Each")
(setq NewTxt (put_txt (rtos len)))
)
(if LenList
(setq LenList (cons (list typ len NewTxt) LenList))
(setq LenList (list (list typ len NewTxt)))
)
) ; progn
(alert "Not a valid object for length")
)
)
)
) ; while
(and (not (zerop total_len))
(princ (strcat "\nTotal length is " (rtos total_len)))
(if (member txt_opt '("Each" "Total"))
(put_txt (strcat "Total " (rtos total_len)))
)
)
(setvar "CMDECHO" usercmd)
(princ)
)
(prompt "\nGet Length loaded, Enter length to run")
(princ)

 

 

 

 

 

0 Likes
Accepted solutions (1)
746 Views
8 Replies
Replies (8)
Message 2 of 9

Kent1Cooper
Consultant
Consultant

@paul9ZMBV wrote:

.... after the total is shown the user has the option to divide the total by the inputted amount and display that amount.

It would also be nice to have the dimensions turn blue (as in selected) when selecting each dimension as currently you cant visibly see which dims are selected.

....


For the highlighting, try adding this [untested]:

....

  (if (member (setq typ (cdr (assoc 0 (entget en)))) ent_allowed)
    (progn
      (redraw en 3); highlight
      (cond
        ((vlax-property-available-p obj 'Measurement)

....

 

You may want to add a REGEN command at the end to wipe out all the highlighting.

 

For the dividing, would you want the result only displayed at the command line, or also added to the drawn Text when that's called for?  If the latter, what kind of extra wording would it entail, and would Mtext make more sense?

Kent Cooper, AIA
0 Likes
Message 3 of 9

paul9ZMBV
Advocate
Advocate

Thanks for the reply, being a complete Lisp newbie could you kindly add your wording to the original Lisp. (as i'm not sure of the position it should be within the Lisp)

 

Would be nice to have the divide result added to the drawn Text please.

0 Likes
Message 4 of 9

komondormrex
Mentor
Mentor

hey,

if you need to totalize dimensions only, check this  for the start .

 

 

 

(defun c:dimension_total (/ ename_list total_string_point total_string)
	(prompt "Select dimensions")
	(setq divider (if (null divider) 1.0 divider)
		  ename_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "dimension"))))))
		  total_string_point "Total"
	)
	(while (= 'str (type total_string_point)) 
		(initget "Divider Reset")
		(cond 
			(
				(= "Divider"
			   		(setq total_string_point (getpoint (strcat "Pick the point to place total number = " 
			   												(setq total_string
			   														(rtos (/ (apply '+ 
			   																	(mapcar '(lambda (ename) (vla-get-measurement (vlax-ename->vla-object ename))) 
			   																	   		 ename_list
			   																	)
			   															  	 )
			   																 divider
			   															  ) 
																		  (getvar 'dimlunit)
																		  ;(apply 'max (mapcar 'vla-get-primaryunitsprecision (mapcar 'vlax-ename->vla-object ename_list))) 
																		  4
			   														) 
			   												)
			   												" [Divider/Reset]: "
			   										     )
			   							       )
			   		)
				)
					(setq init (initget 6)
						  divider (getreal (strcat "\nEnter divider for total number <" (rtos divider 2 2)  ">: "))
					)
			)
			(
				(= "Reset" total_string_point)
		  			(setq ename_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "dimension")))))))
			)
			(
				t
			)
		)
	)
	(entmake (list '(0 . "text")
			        (cons 10 total_string_point)
			        (cons 1 total_string)
			        (cons 40 (vla-get-textheight (vlax-ename->vla-object (car ename_list))))
					(cons 7 (vla-get-textstyle (vlax-ename->vla-object (car ename_list))))
			 )
	)
	(vla-put-color (vlax-ename->vla-object (entlast)) (vla-get-color (vlax-ename->vla-object (car ename_list)))) 
	(princ)
)

 

 

 

 

0 Likes
Message 5 of 9

paul9ZMBV
Advocate
Advocate

Brilliant thanks, can you kindly change the format to be as many decimal places as per the original dimensions its taking the figure from.

 

For example if one measurement is 23.879 and one is 16.67 the answer will be given as 40.549

 

To have it in the same font as the dimensions would also be nice (but not essential)

 

Really appreciate your help with this

 

0 Likes
Message 6 of 9

komondormrex
Mentor
Mentor

check update above.

0 Likes
Message 7 of 9

paul9ZMBV
Advocate
Advocate

Hi komondormrex

 

That's fantastic, sorry to be a pain, one little tweek please, having thought about it, could I kindly ask you change it to having 4 decimal places by default on all measurement including the divide result, (despite me saying otherwise)

 

Can the adding procedure be taken from the actual measurement (4 decimal places) rather than the visable text measurement. (as the dim style is set to only show 1 decimal place, with rounding up and down)

 

Its great the font etc is the same thanks.

 

Really appreciated Paul

0 Likes
Message 8 of 9

komondormrex
Mentor
Mentor

sure. find update above.

0 Likes
Message 9 of 9

paul9ZMBV
Advocate
Advocate
Accepted solution

Thanks a lot, much appreciated.

Cant thank you enough.

Game changer for me.

0 Likes