bills Posted January 17, 2019 Share Posted January 17, 2019 I have got this lsp from some site, using which I can get the polyline area, text inside it, layer and handle tags into csv file. I would be great i someone could help me by adding polyline length (perimeter) also in this code after polyline area. (defun c:EPD (/ ss i area layer all_data pts csv_file openfile) ; Export Polyline Data ;; pBe Sep 2018 ;; (if (and (setq all_data nil ss (ssget '((0 . "LWPOLYLINE"))) ) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i))) ent (entget e) area (vlax-curve-getarea e) data (mapcar '(lambda (d)(cdr (assoc d ent))) '( 8 70 5)) pts (mapcar 'cdr (vl-remove-if-not '(lambda (d) (= 10 (car d)) ) ent ) ) ) (setq all_data (cons (list (cond ((null (setq ssText (ssget "_CP" pts '((0 . "TEXT"))))) "-" ) ((= (sslength ssText) 1) (cdr (assoc 1 (entget (ssname ssText 0)))) ) ((substr (apply 'strcat (mapcar '(lambda (st) (strcat " | " st)) (vl-sort (mapcar '(lambda (s) (cdr (assoc 1 (Entget s))) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssText))) ) (function (lambda (a b) (< a b) ) ) ) ) ) 4 ) ) ) area (car data) (if (zerop ( logand 1 (cadr data))) "No" "Yes") (caddr data) ) all_data ) ) all_data ) (setq csv_file (getfiled "Save CSV File" (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".csv" ) "csv" 45 ) ) ) (progn (setq openfile (open csv_file "w")) (write-line "Text inside polyline,Polyline Area (m2),Layer,Closed,Handle" openfile ) (foreach itm (vl-sort all_data '(lambda (a b) (< (Cadr a) (cadr b))) ) (write-line (Strcat (Car itm) "," (strcat (rtos (Cadr itm) 2 2) " m2") "," (caddr itm) "," (cadddr itm) "," (last itm) ) openfile ) ) (close openfile) (startapp "notepad" csv_file) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
ronjonp Posted January 17, 2019 Share Posted January 17, 2019 (edited) Try this: (defun c:epd (/ all_data area csv_file d data e ent i len openfile pts s ss sstext st) ; Export Polyline Data ;; pBe Sep 2018 ;; (if (and (setq ss (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i))) ent (entget e) area (vlax-curve-getarea e) ;; RJP » 2019-01-17 added length to results len (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) data (mapcar '(lambda (d) (cdr (assoc d ent))) '(8 70 5)) pts (mapcar 'cdr (vl-remove-if-not '(lambda (d) (= 10 (car d))) ent)) ) (setq all_data (cons (list (cond ((null (setq sstext (ssget "_CP" pts '((0 . "TEXT"))))) "-") ((= (sslength sstext) 1) (cdr (assoc 1 (entget (ssname sstext 0))))) ((substr (apply 'strcat (mapcar '(lambda (st) (strcat " | " st)) (vl-sort (mapcar '(lambda (s) (cdr (assoc 1 (entget s)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sstext))) ) (function (lambda (a b) (< a b))) ) ) ) 4 ) ) ) area len (car data) (if (zerop (logand 1 (cadr data))) "No" "Yes" ) (caddr data) ) all_data ) ) all_data ) (setq csv_file (getfiled "Save CSV File" (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".csv") "csv" 45 ) ) ) (progn (setq openfile (open csv_file "w")) (write-line "Text inside polyline,Polyline Area (m2),Polyline Length (m),Layer,Closed,Handle" openfile ) (foreach itm (vl-sort all_data '(lambda (a b) (< (cadr a) (cadr b)))) (write-line (strcat (car itm) "," (strcat (rtos (cadr itm) 2 2) " m2") "," (strcat (rtos (caddr itm) 2 2) " m") "," (cadddr itm) "," (cadddr (cdr itm)) "," (last itm) ) openfile ) ) (close openfile) (startapp "notepad" csv_file) ) ) (princ) ) Edited January 21, 2019 by ronjonp Quote Link to comment Share on other sites More sharing options...
bills Posted January 18, 2019 Author Share Posted January 18, 2019 Thanks Ronjonp It works fine if I select one pline only. But if 2 or more number of plines are selected then it gives error as below: Error: argument used to compare incorrect: (3.61149 7.70169) (5.12111 9.14575) Quote Link to comment Share on other sites More sharing options...
ronjonp Posted January 18, 2019 Share Posted January 18, 2019 Ooops ... should have tested. Code updated above. Quote Link to comment Share on other sites More sharing options...
bills Posted January 19, 2019 Author Share Posted January 19, 2019 Thanks too much. It works perfectly as I needed. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted January 21, 2019 Share Posted January 21, 2019 On 1/18/2019 at 10:24 PM, bills said: Thanks too much. It works perfectly as I needed. Glad to help Quote Link to comment Share on other sites More sharing options...
Morey Posted August 13, 2020 Share Posted August 13, 2020 (edited) How would tweak this code to output Area SF and Perimeter LF instead? Tried edit below, without success. Any help would be greatly appreciated. (strcat (rtos (cvunit (cadr itm) "sq meter" "sq feet") 2 2) "") Regards, Morey Edited August 13, 2020 by Morey Quote Link to comment Share on other sites More sharing options...
ronjonp Posted August 14, 2020 Share Posted August 14, 2020 The code above will return the area in whatever units you have it drawn in. Just change the m2 and m callouts to f2 and f. Quote Link to comment Share on other sites More sharing options...
Morey Posted August 14, 2020 Share Posted August 14, 2020 Ronjonp, For some reason the suggested edit did not work on my end. The following did work. Gives both Area SQFT and Perimeter FT. (defun c:EPD (/ all_data area csv_file d data e ent i len openfile pts s ss sstext st) (if (and (setq ss (ssget '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i))) ent (entget e) area ( / (vlax-curve-getarea e) (* 144));;/ 144 (or 12 * 12) Imperial len (vlax-curve-getdistatparam e (vlax-curve-getendparam e));;Length Perimeter data (mapcar '(lambda (d) (cdr (assoc d ent))) '(8 70 5)) pts (mapcar 'cdr (vl-remove-if-not '(lambda (d) (= 10 (car d))) ent)) ) (setq all_data (cons (list (cond ((null (setq sstext (ssget "_CP" pts '((0 . "TEXT"))))) "NO SPACE TEXT FOUND") ((= (sslength sstext) 1) (cdr (assoc 1 (entget (ssname sstext 0))))) ((substr (apply 'strcat (mapcar '(lambda (st) (strcat " | " st)) (vl-sort (mapcar '(lambda (s) (cdr (assoc 1 (entget s)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sstext))) ) (function (lambda (a b) (< a b))) ) ) ) 4 ) ) ) area len (car data) (if (zerop (logand 1 (cadr data))) "No" "Yes" ) (caddr data) ) all_data ) ) all_data ) (setq csv_file (getfiled "Save CSV File" (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".csv") "csv" 45 ) ) ) (progn (setq openfile (open csv_file "w")) (write-line "Space Name/Class,Area (sqft),Perimeter (ft),Layer,Polyline Closed?,Object Handle ID" openfile ) (foreach itm (vl-sort all_data '(lambda (a b) (< (cadr a) (cadr b)))) (write-line (strcat (car itm) "," (strcat (rtos (cadr itm) 2 2) "") "," (strcat (rtos (/ (caddr itm) 12) 2 2) "");;or /* Divide or Multiply here "," (cadddr itm) "," (cadddr (cdr itm)) "," (last itm) ) openfile ) ) (close openfile) (startapp "notepad" csv_file) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
ronjonp Posted August 15, 2020 Share Posted August 15, 2020 (edited) Assuming your units are set correctly. all you need to do is change this to the output: (strcat (car itm) "," ;; NOTE (getvar 'lunits) (strcat (rtos (cadr itm) (getvar 'lunits) 2) " f2") "," ;; NOTE (getvar 'lunits) (strcat (rtos (caddr itm) (getvar 'lunits) 2) " f") "," (cadddr itm) "," (cadddr (cdr itm)) "," (last itm) ) Edited August 15, 2020 by ronjonp 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.