Length and Width of Rectangles With ID to excel

April 30, 2020

dear forum

i have multiple rectangles i need to extract the length and width of all of them with corresponding ID writes them on excel
Like attached

the ID's are multiple sometimes, all the text within the rectangle

thanks

sample.dwg SAMPLE.xlsx

May 1, 2020

Try this, you must change output file name and directory. Just makes a csv file can open with excel.

It did fail on your sample dwg, if text is to close to an edge it can not make a boundary. It should fail at the one causing problem.

;; https://www.cadtutor.net/forum/topic/70418-length-and-width-of-rectangles-with-id-to-excel/
; change directory and file name to suit
; (setq fname (open "d:\\acadtemp\\test.csv" "w"))
: by AlanH May 2020

(defun c:rectcsv ( / tobj tlay lst ss obj obj2 fname x idpol)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq tobj (entget (car (entsel "Pick text for polygons"))))
(setq tlay (cdr (assoc 8 tobj)))
(setq lst '())
(if (setq ss (ssget (list (cons 0  "*TEXT")(cons 8  tlay))))
(progn
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object(ssname ss (setq x (- x 1)))))
(setq txtpt (vlax-get  obj 'insertionpoint))
(setq txtpt (list (car txtpt)(cadr txtpt)))
(setq txt (vla-get-textstring obj))
(command "zoom" "c" txtpt 1000.)
(command "bpoly" txtpt "")
(setq obj2 (vlax-ename->vla-object (entlast)))
(vla-GetBoundingBox obj2 'minpoint 'maxpoint)
(setq pointmin (vlax-safearray->list minpoint))
(setq pointmax (vlax-safearray->list maxpoint))
(setq len (- (car pointmax)(car pointmin)))
(setq ht (- (cadr pointmax)(cadr pointmin)))
(setq lst (cons (list txt len ht) lst))
(command "erase" "last" "")
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
(setq fname (open "d:\\acadtemp\\test.csv" "w"))
(foreach idpol lst
(write-line (strcat (rtos (nth 1 idpol) 2 3) "," (rtos (nth 2 idpol) 2 3) "," (nth 0 idpol)) fname)
)
(close fname)
)
)
(setvar 'osmode oldsnap)
(princ)
)

May 1, 2020

1. It's not difficult to populate LWPolyline + ssget wp cp

2. you can get min max x,y coordinates for each LWPolyline as box dimensions as well (orthogonal)

see this old thread may help.

p/s: if rectangles erased only dimensions left?

Edited May 1, 2020 by hanhphuc

May 2, 2020

hanphuc Good idea the dwg has lines as the shapes hence the bpoly approach makes life a lot harder.

May 2, 2020

thank you for your response,

i can make the lines inside the rectangles to another layer and isolate only rectangles and text if that will make the lisp a lot easy.

which ever is easier take the data from the rectangle or dimension, the main problem is i don't know how to include ID in the collected data

the lisp was excellent but it is giving me wrong values on rectangles with multiple text inside

for example: rectangle 1 has length = x width =y and ID is text1 text2 text3
some rectangles has only 1 text inside some has multiple

Edited May 2, 2020 by tefached
got the directory problem now

May 2, 2020

May 2, 2020

Here you have it... Select rectangles, and it should be fine.

Just make sure that all the rectangles and texts are visible on the screen prior to pressing Enter.

(defun c:rectcsv
       
       ( / *error* acadobj activeundo adoc coords csv del dis getcoords i len lst->str opf pth ss txt txtcont wid)
    
    (defun *error* ( msg )
	(if opf (close opf))
	(vla-EndUndoMark adoc)
	(if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
	    (princ (strcat "Error: " msg))
	    )
	)
    
    (defun getcoords (ln) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ln))))
    (defun lst->str (lst del) (apply 'strcat (append (list (car lst)) (mapcar '(lambda (x) (strcat del x)) (cdr lst)))))
    
    (setq acadobj (vlax-get-acad-object)
	  adoc (vla-get-ActiveDocument acadobj)
	  activeundo nil)
    
    (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))
    
    (if
	(and
	    (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))))
	    (setq pth (getfiled "Select CSV Output file" "" "csv" 1))
	    )
	(progn
	    (setq del (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
	    (repeat (setq i (sslength ss))
		(setq coords (getcoords (ssname ss (setq i (1- i))))
		      dis (mapcar 'distance coords (cdr coords))
		      wid (apply 'min dis)
		      len (apply 'max dis)
		      txt (ssget "CP" coords '((0 . "TEXT")))
		      txtcont (if txt (strcat "\"" (lst->str (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) (JH:selset-to-list txt)) ",") "\"") "")
		      csv (cons (strcat (lst->str (mapcar 'rtos (list len wid)) del) del txtcont) csv)
		      )
		)
	    (if (setq opf (open pth "w"))
		(progn
		    (foreach x (cons "L,W,ID" (reverse csv)) (write-line x opf))
		    (close opf)
		    ; (startapp "explorer" pth) ; <-- To directly open the CSV file, uncomment this line
		    )
		(alert "\nCSV file not successfully created! Please check that the file is closed and try again!")
		)
	    )
	)
    (if activeundo nil (vla-EndUndoMark adoc))
    (princ)
    )

;; JH:selset-to-list --> Jonathan Handojo
;; Returns a list of entities from a selection set
;; ss - selection set

(defun JH:selset-to-list (selset / lst iter)
    (if selset
	(repeat (setq iter (sslength selset))
	    (setq lst (cons (ssname selset (setq iter (1- iter))) lst))
	    )
	)
    )

May 2, 2020

wow! perfect! thank you so much for this!

May 2, 2020

(defun c:LxW (/ *error* csv dxf ss s en fn f i l lst)
 ;hanhphuc 01.05.2020
  (defun *error* (msg)
    (if	f
      (close f)
    )
    (terpri)
    (princ msg)
  )

  (defun csv (, l)
    (substr (apply
	      'strcat
		   (mapcar '(lambda (x) (strcat , (if (numberp x) (rtos x 2 3) x ) ) )
		    l
	           )
	     )
	    2
     )
   )

  (or
    (and
      (setq dxf	'((i en) (cdr (assoc i (entget en))))
	    ss	(ssget '((0 . "LWPOLYLINE")
			 (90 . 4)
			 (-4 . "&=")
			 (70 . 1)
			)
		)
      )
      (setq fn (vl-filename-mktemp "LxW.csv"))
      (setq f (open fn "w"))
      (write-line "L,W,ID" f)
      (repeat (setq i (sslength ss))
	(setq en  (ssname ss (setq i (1- i)))
	      lst (mapcar
		    'cdr
		    (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget en))
		  )
	)
	(and
	  (setq s (ssget "_CP" lst '((0 . "TEXT,DIMENSION"))))
	  (setq	l
		   (apply 'append
			  (mapcar
			    '(lambda (x)
			       (vl-remove-if
				 '(lambda (x) (or (= x "") (not x)))
				 (list (dxf 1 x) (dxf 42 x))
			       )
			     )
			    (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
			  )
		   )
		lst (vl-remove-if-not 'numberp l)
	  )
	  (= (length lst) 2)
	  (write-line
	    (csv ","
		 (append (vl-sort lst '>)
			 (list (csv ";" (vl-remove-if 'numberp l)))
		 )
	    )
	    f
	  )
	)
      )
      (if f
	(progn (close f)
	       (vl-cmdf "_START" fn)
	)
      )
    )
    (princ
      "\nhttps://www.cadtutor.net/forum/topic/70418-length-and-width-of-rectangles-with-id-to-excel/"
    )
  )
  (princ)
)

another method ssget dimensions

Edited May 2, 2020 by hanhphuc
code tags

February 4, 2021

Thank you Jonathan! I am using this lisp but sometime the size of rectangles are in direction.

Example:

REC1: 200x400

REC2: 350x240 (the W dim is bigger than the L dim). While the lisp always shows the (Small size) x (Big size)

So could we make it in the lisp. Thanks!

February 25, 2021

Hello good mornig for everyone.
I have used this post because it looks a lot like what I intend.
I have used the lisp from this post, but it does not identify the numbers within the rectangles, only some.
I detail what I need, to see if you can help me. I use Autocad 2019.
I have a drawing with many rectangles of different sizes and colors.
Option 1:
With all the numbered rectangles inside, select the rectangles and extract a table or csv file with the measurements (always greater x smaller), identifier (number inside the rectangle), color.
Option 2:
Select the rectangles and automatically number the rectangles, extracting a table or csv file with the measurements (always greater x less), identifier (number inside the rectangle), color.

I attach files that I normally work with, in case they help to use them, ideas or modifications. (Note: The lisp "rectangle dims by color.lsp" I would like it to have a precision of 3 decimal places and group the same, but I understand that this would complicate the association with identifier)

I also attach a website that I found with a list that numbers the rectangles and exports a table with a lot of data, but it doesn't work for me either.

http://wlecouteur.blogspot.com/2020/01/

https://www.youtube.com/watch?v=lus7WLJ2wJQ

(I also have a VBA that recognizes the contour areas and exports to excel, I don't know if it could be modified so that it also exports length x width)

Best regards to all.

Foam Pad.dwg numera_2.lsp rectangle dims by color.lsp

medi_excel07.dvb

Edited February 25, 2021 by raziel

February 25, 2021

Rectangle by colour change (vl-princ-to-string c) to (rtos c 2 3)

To get say X Y Count 78,83,93 in a table you need to add to the list of X Y the ID so when do sort can also make a string of the rectangs of that size.

What do you know about lisp ? It's a bit of a task wading through code and modifying to suit. Its not a 5 minute fix you may need to "Donate" to the beer fund.

February 26, 2021

On 2/5/2021 at 2:31 AM, RonnieBN said:

Thank you Jonathan! I am using this lisp but sometime the size of rectangles are in direction.

Example:

REC1: 200x400

REC2: 350x240 (the W dim is bigger than the L dim). While the lisp always shows the (Small size) x (Big size)

So could we make it in the lisp. Thanks!

Can you define what "sometime" is? What's the criteria?

February 26, 2021

15 minutes ago, Jonathan Handojo said:

Can you define what "sometime" is? What's the criteria?

I would guess that it is width 'X' and height "Y" but the way you sort the distances it's always reported as largest to smallest.. so something like this would report the same.

February 26, 2021

3 minutes ago, ronjonp said:

I would guess that it is width 'X' and height "Y" but the way you sort the distances it's always reported as largest to smallest.. so something like this would report the same.

Well, I guess that makes sense... because I just thought (by definition), that the width is the smaller of the two sides of the rectangle... But yea... I can certainly change it to suit.

February 26, 2021

10 minutes ago, Jonathan Handojo said:

Well, I guess that makes sense... because I just thought (by definition), that the width is the smaller of the two sides of the rectangle... But yea... I can certainly change it to suit.

The horizontal rectangle would be much easier to take a nap on than the vertical on the right. This is where the width vs height came into play in my brain.

Edited February 26, 2021 by ronjonp

February 26, 2021

7 hours ago, BIGAL said:

Rectangle by colour change (vl-princ-to-string c) to (rtos c 2 3)

To get say X Y Count 78,83,93 in a table you need to add to the list of X Y the ID so when do sort can also make a string of the rectangs of that size.

What do you know about lisp ? It's a bit of a task wading through code and modifying to suit. Its not a 5 minute fix you may need to "Donate" to the beer fund.

Thank you very much for answering.
My knowledge of lisp is very scarce, not to say null, I am aware that I have to study ASAP lisp.

I know how complicated what I ask can be. If not possible, I understand. So attach the tools I use now, in case it made the job easier.

Best regards

March 2, 2021

On 2/25/2021 at 11:14 PM, Jonathan Handojo said:

Well, I guess that makes sense... because I just thought (by definition), that the width is the smaller of the two sides of the rectangle... But yea... I can certainly change it to suit.

Yeah, thanks Ronjonp for your explanation.

When I work with the material with direction (grain), the size of rectangles in horizontal/vertical are should not be reversed.

March 3, 2021

15 hours ago, RonnieBN said:

Yeah, thanks Ronjonp for your explanation.

When I work with the material with direction (grain), the size of rectangles in horizontal/vertical are should not be reversed.

Very well. Simple fix to it:

(defun c:rectcsv
       
       ( / *error* acadobj activeundo adoc coords csv del dis getcoords i len lst->str opf pth ss txt txtcont wid)
    
    (defun *error* ( msg )
	(if opf (close opf))
	(vla-EndUndoMark adoc)
	(if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
	    (princ (strcat "Error: " msg))
	    )
	)
    
    (defun getcoords (ln) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ln))))
    (defun lst->str (lst del) (apply 'strcat (append (list (car lst)) (mapcar '(lambda (x) (strcat del x)) (cdr lst)))))
    
    (setq acadobj (vlax-get-acad-object)
	  adoc (vla-get-ActiveDocument acadobj)
	  activeundo nil)
    
    (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))
    
    (if
	(and
	    (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))))
	    (setq pth (getfiled "Select CSV Output file" "" "csv" 1))
	    )
	(progn
	    (setq del (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
	    (repeat (setq i (sslength ss))
		(setq coords (vl-sort (getcoords (ssname ss 0)) '(lambda (a b) (< (cadr a) (cadr b))))
		      dis (mapcar 'distance coords (cdr coords))
		      wid (car dis)
		      len (cadr dis)
		      txt (ssget "CP" coords '((0 . "TEXT")))
		      txtcont (if txt (strcat "\"" (lst->str (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) (JH:selset-to-list txt)) ",") "\"") "")
		      csv (cons (strcat (lst->str (mapcar 'rtos (list len wid)) del) del txtcont) csv)
		      )
		)
	    (if (setq opf (open pth "w"))
		(progn
		    (foreach x (cons "L,W,ID" (reverse csv)) (write-line x opf))
		    (close opf)
		    ; (startapp "explorer" pth) ; <-- To directly open the CSV file, uncomment this line
		    )
		(alert "\nCSV file not successfully created! Please check that the file is closed and try again!")
		)
	    )
	)
    (if activeundo nil (vla-EndUndoMark adoc))
    (princ)
    )

;; JH:selset-to-list --> Jonathan Handojo
;; Returns a list of entities from a selection set
;; ss - selection set

(defun JH:selset-to-list (selset / lst iter)
    (if selset
	(repeat (setq iter (sslength selset))
	    (setq lst (cons (ssname selset (setq iter (1- iter))) lst))
	    )
	)
    )

March 4, 2021

On 3/3/2021 at 6:14 AM, Jonathan Handojo said:

Very well. Simple fix to it:

Thanks Jonathan! I tested but there are something wrong happened. Could you check it again?

TEST.dwg

Sign In

Length and Width of Rectangles With ID to excel

Recommended Posts

tefached

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Jonathan Handojo

Tharwat

Tharwat

Posted Images

BIGAL

hanhphuc

BIGAL

tefached

tefached

Jonathan Handojo

tefached

hanhphuc

RonnieBN

raziel

BIGAL

Jonathan Handojo

ronjonp

Jonathan Handojo

ronjonp

raziel

RonnieBN

Jonathan Handojo

RonnieBN

Join the conversation

Jonathan Handojo

Tharwat

Tharwat

Tutorials

Forums

Activity