Jump to content

Length and Width of Rectangles With ID to excel


tefached

Recommended Posts

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

Link to comment
Share on other sites

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)
)

 

Link to comment
Share on other sites

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 by hanhphuc
Link to comment
Share on other sites

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 by tefached
got the directory problem now
Link to comment
Share on other sites

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))
	    )
	)
    )

 

  • Like 2
Link to comment
Share on other sites


 
(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 by hanhphuc
code tags
Link to comment
Share on other sites

  • 9 months later...

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!

Link to comment
Share on other sites

  • 3 weeks later...

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 by raziel
Link to comment
Share on other sites

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.

 

 

 

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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.

 

image.png.9ec7e508b739142248df53393457eae5.png

 

Link to comment
Share on other sites

 

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.

 

image.png.9ec7e508b739142248df53393457eae5.png

 

 

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.

Link to comment
Share on other sites

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 by ronjonp
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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. 

image.thumb.png.0560b9bd64931de0b713c0791a4ef249.png

Link to comment
Share on other sites

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. 

image.thumb.png.0560b9bd64931de0b713c0791a4ef249.png

 

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))
	    )
	)
    )

 

Link to comment
Share on other sites

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

Capture.JPG

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...