tefached Posted April 30, 2020 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 1, 2020 Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted May 1, 2020 Share Posted May 1, 2020 (edited) 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 2, 2020 Share Posted May 2, 2020 hanphuc Good idea the dwg has lines as the shapes hence the bpoly approach makes life a lot harder. Quote Link to comment Share on other sites More sharing options...
tefached Posted May 2, 2020 Author Share Posted May 2, 2020 (edited) 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 Quote Link to comment Share on other sites More sharing options...
tefached Posted May 2, 2020 Author Share Posted May 2, 2020 Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted May 2, 2020 Share Posted 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)) ) ) ) 2 Quote Link to comment Share on other sites More sharing options...
tefached Posted May 2, 2020 Author Share Posted May 2, 2020 wow! perfect! thank you so much for this! Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted May 2, 2020 Share Posted May 2, 2020 (edited) (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 Quote Link to comment Share on other sites More sharing options...
RonnieBN Posted February 4, 2021 Share Posted 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! Quote Link to comment Share on other sites More sharing options...
raziel Posted February 25, 2021 Share Posted February 25, 2021 (edited) 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted February 25, 2021 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted February 26, 2021 Share Posted 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? Quote Link to comment Share on other sites More sharing options...
ronjonp Posted February 26, 2021 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted February 26, 2021 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted February 26, 2021 Share Posted February 26, 2021 (edited) 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 Quote Link to comment Share on other sites More sharing options...
raziel Posted February 26, 2021 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
RonnieBN Posted March 2, 2021 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted March 3, 2021 Share Posted 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)) ) ) ) Quote Link to comment Share on other sites More sharing options...
RonnieBN Posted March 4, 2021 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.