Tharwat Posted March 4, 2021 Share Posted March 4, 2021 @RonnieBN Give this a shot. (defun c:Test ( / int sel cad ent lst ref one two out csv get) ;; Tharwat Al Choufi - Date: 4.Mar.2021 ;; (and (princ "\nSelect closed polylines with four corners : ") (setq int -1 sel (ssget '((0 . "*POLYLINE") (-4 . "<AND") (-4 . "&=") (70 . 1) (90 . 4) (-4 . "AND>")))) (or (vla-zoomextents (setq cad (vlax-get-acad-object))) t) (while (setq int (1+ int) ent (ssname sel int)) (setq lst nil) (foreach p (entget ent) (if (= (car p) 10) (setq lst (cons (cdr p) lst))) ) (and (setq ref (ssget "_CP" lst '((0 . "TEXT")))) (setq one (distance (car lst) (cadr lst)) two (distance (car lst) (last lst)) ) (if (equal (cadar lst) (cadadr lst) 1e-4) (setq len one wid two) (setq len two wid one) ) (setq out (cons (list len wid (cdr (assoc 1 (entget (ssname ref 0))))) out)) ) ) (or (vla-zoomprevious cad) t) (setq csv (getfiled "Specify file name" (getvar 'DWGPREFIX) "csv" 1)) (setq get (open csv "w")) (write-line "L,W,ID" get) (foreach itm out (write-line (strcat (rtos (car itm) 2 2) "," (rtos (cadr itm) 2 2) "," (caddr itm)) get) ) (close get) ) (princ) ) (vl-load-com) 1 Quote Link to comment Share on other sites More sharing options...
RonnieBN Posted March 5, 2021 Share Posted March 5, 2021 20 hours ago, Tharwat said: Give this a shot. Thanks Tharwat! It works. But an we make it works with the rectangles without the ID inside? Quote Link to comment Share on other sites More sharing options...
Tharwat Posted March 5, 2021 Share Posted March 5, 2021 3 minutes ago, RonnieBN said: Thanks Tharwat! It works. But can we make it works with the rectangles without the ID inside? Certainly. (defun c:Test ( / int sel cad ent lst one two out csv get) ;; Tharwat Al Choufi - Date: 4.Mar.2021 ;; (and (princ "\nSelect closed polylines with four corners : ") (setq int -1 sel (ssget '((0 . "*POLYLINE") (-4 . "<AND") (-4 . "&=") (70 . 1) (90 . 4) (-4 . "AND>")))) (while (setq int (1+ int) ent (ssname sel int)) (setq lst nil) (foreach p (entget ent) (if (= (car p) 10) (setq lst (cons (cdr p) lst))) ) (and (setq one (distance (car lst) (cadr lst)) two (distance (car lst) (last lst)) ) (if (equal (cadar lst) (cadadr lst) 1e-4) (setq len one wid two) (setq len two wid one) ) (setq out (cons (list len wid) out)) ) ) (setq csv (getfiled "Specify file name" (getvar 'DWGPREFIX) "csv" 1)) (setq get (open csv "w")) (write-line "L,W" get) (foreach itm out (write-line (strcat (rtos (car itm) 2 2) "," (rtos (cadr itm) 2 2)) get) ) (close get) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
RonnieBN Posted March 5, 2021 Share Posted March 5, 2021 Just test your work. Thanks! I was meaning that could we make the lisp give the results as for both case 1- with the ID and 2-without the ID in only one command/lisp. Thanks! Quote Link to comment Share on other sites More sharing options...
Tharwat Posted March 5, 2021 Share Posted March 5, 2021 I wish you can make a donation then I will make it for you as well. Quote Link to comment Share on other sites More sharing options...
RonnieBN Posted March 8, 2021 Share Posted March 8, 2021 On 3/5/2021 at 11:42 AM, Tharwat said: I wish you can make a donation then I will make it for you as well. Hi, I am not able to make the donation at this time. I really appreciate your works. Thanks! Quote Link to comment Share on other sites More sharing options...
Tharwat Posted March 8, 2021 Share Posted March 8, 2021 25 minutes ago, RonnieBN said: Hi, I am not able to make the donation at this time. I really appreciate your works. Thanks! No worries @RonnieBN , please find the latest version that should cover the two options with / without ID [ Yes , No ] < Default value Tes > as ordered in the program. Please try the following untested codes and let me know how you get on with it. (defun c:Test (/ *error* rep int sel zom cad ent lst ref one two out csv get) ;; Tharwat Al Choufi - Date: 8.Mar.2021 ;; (defun *error* (msg) (and cad zom (vla-zoomprevious cad)) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*BREAK*")) (princ (strcat "\nError =>: " msg)) ) (princ) ) ;; ;; (and (or (initget 6 "Yes No") (setq rep (cond ((getkword "\nInclude ID column [Yes,No] < Yes > : ")) ("Yes") ) ) ) (princ "\nSelect closed polylines with four corners : ") (setq int -1 sel (ssget '((0 . "*POLYLINE") (-4 . "<AND") (-4 . "&=") (70 . 1) (90 . 4) (-4 . "AND>") ) ) ) (setq zom (or (vla-zoomextents (setq cad (vlax-get-acad-object))) t) ) (while (setq int (1+ int) ent (ssname sel int) ) (setq lst nil) (foreach p (entget ent) (if (= (car p) 10) (setq lst (cons (cdr p) lst)) ) ) (and (setq one (distance (car lst) (cadr lst)) two (distance (car lst) (last lst)) ) (if (equal (cadar lst) (cadadr lst) 1e-4) (setq len one wid two ) (setq len two wid one ) ) (setq out (cons (list len wid (if (and (= rep "Yes") (setq ref (ssget "_CP" lst '((0 . "TEXT")))) ) (cdr (assoc 1 (entget (ssname ref 0)))) "," ) ) out ) ) ) ) (or (setq zom (vla-zoomprevious cad)) t) (setq csv (getfiled "Specify file name" (getvar 'DWGPREFIX) "csv" 1) ) (setq get (open csv "w")) (write-line (strcat "L,W" (if (= rep "Yes") ",ID" "" ) ) get ) (foreach itm out (write-line (strcat (rtos (car itm) 2 2) "," (rtos (cadr itm) 2 2) "," (caddr itm) ) get ) ) (close get) ) (princ) ) (vl-load-com) 1 Quote Link to comment Share on other sites More sharing options...
RonnieBN Posted March 9, 2021 Share Posted March 9, 2021 20 hours ago, Tharwat said: No worries @RonnieBN , please find the latest version that should cover the two options with / without ID [ Yes , No ] < Default value Tes > as ordered in the program. Please try the following untested codes and let me know how you get on with it. I have tested. It works perfectly and so helpful. I appreciate so much! Quote Link to comment Share on other sites More sharing options...
Tharwat Posted March 9, 2021 Share Posted March 9, 2021 1 hour ago, RonnieBN said: I have tested. It works perfectly and so helpful. I appreciate so much! You're welcome anytime. Quote Link to comment Share on other sites More sharing options...
Zaidkhot Posted August 23, 2021 Share Posted August 23, 2021 Hey Tharwat. I am a newbie here in lisp. Can you tell me how do I change whats the outcome in excel file. I have attached jpeg showing how I want. What lines do I need to Edit? 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.