scremin Posted June 15, 2012 Share Posted June 15, 2012 Hello everyone, I am a brand-new member of this forum and I would really appreciate some help. I'm in need of a routine do to the following: --Add text to represent a closed polyline label. --Then the routine should take polyline area and export the Label and the area data to an Excel file, like showed in the image. I really need some help, because this repetitive job is killing me. I have like 900 polylines to give a Label and extract the area. Thanks Quote Link to comment Share on other sites More sharing options...
mo70mo70 Posted January 11, 2013 Share Posted January 11, 2013 How to create texts to "name" closed polylines and export "names" and area to active cell excel iam mohmed fawzy maile mo70no70@yahoo.com Quote Link to comment Share on other sites More sharing options...
Costinbos77 Posted January 12, 2013 Share Posted January 12, 2013 (edited) The program searches all polylines on selected layer . For starters try this: (defun c:aa () ; V : 13.01.2013 ; 12.01.2013 . (setvar "cmdecho" 0) (setq osm (getvar "osmode") ) (setvar "osmode" 0) (if (setq ht 0.2 lsel 0 ob (car (entsel "\n Select an Object for LAYER : < Pick > : ")) ) (progn (command "zoom" "e") (setq str (cdr (assoc 8 (entget ob)) ) sel (ssget "X" (list '(0 . "LWPOLYLINE,POLYLINE") (cons 8 str)) ) ) ; (if sel (progn (command "zoom" "o" sel "") (sssetfirst nil sel) ; Selectare Vizualizare Selectie ! (if (/= (getstring (strcat "\n SELECTED objects on LAYER : " str " ;\n Any = NO ; Enter = OK : ")) "") (setq sel nil)) (sssetfirst sel) ; DeSelectare Vizualizare Selectie ! ) ) ; if sel (if sel (progn (or (vl-load-com)) (setq lsel (sslength sel) cale (strcat (getvar "dwgprefix") (getvar "dwgname") " - " (rtos (getvar "cdate") 2 6) ".csv") f (open cale "w") i 0) (write-line "\nLabel, Area\n-------------------------------" f) (while (< i lsel) (setq nobi (ssname sel i) nobv (vlax-ename->vla-object nobi) ar (vla-get-Area nobv) ars (rtos ar 2 5) i (1+ i) lc (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates nobv))) llc (length lc) n (/ llc 2.) j 0 sx 0 sy 0) (while (< j llc) (setq sx (+ (nth j lc) sx) j (1+ j) sy (+ (nth j lc) sy) j (1+ j) ) ) ; wh (command "text" "m" (list (/ sx n) (/ sy n) 0) ht 0 (strcat "\n Area " (itoa i) " = " ars)) (princ (strcat "\n Area " (itoa i) " : " ars)) (write-line (strcat "Area " (itoa i) ", " ars) f) ) ; wh < (if (and cale (findfile cale)) (close f)) ) ) ; if sel )) ; if ob (setvar "osmode" osm) (setvar "cmdecho" 1) (princ (strcat "\n Height of Texts : " (rtos ht 2 5) "\n Number of Areas : " (itoa lsel) " .")) (princ "\n END !")(princ) ) ; end defun c:aa The program does not write directly in Excel, but you can open the results file .CSV with Excel . CSV file is saved to DWG path. To write something in Excel, you need a function to open and write to Excel and is more complex. Simple and to the point. Processes only selected layer. NOT check different : - If the polyline has 2 vertecsi and the area is 0 ; - Do not check if the polyline is closed ; - height text ; - Start writing that labeling ; - Etc. Lisp was written in about 30 minutes. Edited January 14, 2013 by Costinbos77 Quote Link to comment Share on other sites More sharing options...
gS7 Posted January 12, 2013 Share Posted January 12, 2013 You Can Find the Solution here for Your requirement Awesome Program Done by Lee Mac http://www.lee-mac.com/arealabel.html Quote Link to comment Share on other sites More sharing options...
Costinbos77 Posted January 12, 2013 Share Posted January 12, 2013 (edited) gS7, It is very hard as usual. I thought a simple variant in a short time, to help scremin to process the 900 polylines quickly. As you need other facilities, they added. Edited January 13, 2013 by Costinbos77 Quote Link to comment Share on other sites More sharing options...
fixo Posted January 12, 2013 Share Posted January 12, 2013 Here is my 2 cents (defun C:DXLW (/ acsp adoc ang ar area centpoint col fname inspt n plent plineobj regionobj row sset thgt tot tst tsz txtobj xldata xlapp xlbook xlbooks xlcells xlsheet xlsheets) (vl-load-com) ;;;local defun (defun setcelltext(cells row column value) (vl-catch-all-apply 'vlax-put-property (list cells 'Item row column (vlax-make-variant (vl-princ-to-string value) )) ) ;;----------------------------- main part ---------------------;; (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object)))) (or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc)))) (vla-startundomark adoc) (setq tsz (getvar "textsize")) (setq tst (getvar "textstyle")) ;; set text style you need: (setvar "textstyle" "Standard") ;; set text size (setq thgt (getdist "\nText Height: ")) (if (not thgt)(setq thgt (getvar "dimtxt"))) (setvar "textsize" thgt) (princ "\n\t---\tSelect contours\t---") (setq sset (ssget '( (0 . "LWPOLYLINE") (8 . "ANNO-AREA"); <-- set layer of polygons (-4 . "<OR") (70 . 1);flag for closed curve, linetype generation disabled (70 . 129);flag for closed curve, linetype generation enabled (-4 . "OR>") ) ) ) (setq n 1 tot 0.0) (while (setq plent (ssname sset 0)) (setq plineObj (vlax-ename->vla-object plent) ar (vla-get-area plineObj) tot (+ tot ar) area (rtos ar 2 2) ) (setq regionObj (car (vlax-invoke acsp 'addregion (list plineObj)))) (setq centPoint (trans (vlax-get regionObj 'centroid) 1 0)) (setq inspt (vlax-3d-point centPoint)) (setq txtobj (vla-addtext acsp (strcat "Label-"(itoa n)) inspt thgt)) (vla-put-alignment txtobj acAlignmentMiddleCenter) (vla-put-textalignmentpoint txtobj inspt) (vla-put-insertionpoint txtobj inspt) (setq xldata (append xldata (list (list (strcat "Label-"(itoa n)) area)))) (vl-catch-all-apply '(lambda() (progn (vla-delete regionObj) (vlax-release-object regionObj) ))) (setq n (1+ n)) (ssdel plent sset) ) (print xldata) (princ "\nTotal: ") (print tot) ;;------------------------ Excel part ----------------------------;; (setq xlapp (vlax-get-or-create-object "Excel.Application") xlbooks (vlax-get-property xlapp 'Workbooks) xlbook (vlax-invoke-method xlbooks 'Add) xlsheets (vlax-get-property xlbook 'Sheets) xlsheet (vlax-get-property xlsheets 'Item 1) xlcells (vlax-get-property xlsheet 'Cells) ) (vla-put-visible xlapp :vlax-true) (vla-put-name xlsheet "Plan1") (setq row 1) (foreach label xldata (setq col 1) (foreach item label (setcelltext xlcells row col item) (setq col (1+ col) ) ) (setq row (1+ row) ) ) (setcelltext xlcells row 1 "Total:") (setcelltext xlcells row 2 (rtos tot 2 2));<-- precision 2 decimal (vlax-invoke-method (vlax-get-property xlsheet 'Columns) 'AutoFit) (setq fname (strcat (getvar "dwgprefix")(vl-string-right-trim ".dwg" (getvar "dwgname")) ".xls")) (vlax-invoke-method xlbook 'SaveAs fname nil nil nil :vlax-false :vlax-false 1 2 ) (vlax-invoke-method xlbook 'Close) (gc) (vlax-invoke-method xlapp 'Quit) (mapcar '(lambda (x) (vl-catch-all-apply '(lambda () (vlax-release-object x) ) ) ) (list xlcells xlsheet xlsheets xlbook xlbooks xlapp) ) (setq xlapp nil) (gc)(gc) (alert (strcat "File saved as:\n" fname)) (setvar "textsize" tsz) (setvar "textstyle" tst) (vla-endundomark adoc) (princ) ) (princ "\n\t---\tStart command with DXLW ...\t---") (prin1) (or (vl-load-com)(princ)) Quote Link to comment Share on other sites More sharing options...
Madruga_SP Posted January 12, 2013 Share Posted January 12, 2013 Congratulations Fixo! Your code is just amazing. Costinbos77 said: To write something in Excel, you need a function to open and write to Excel and is more complex. I totally agree. But here in this excellent forum there are people who doing things unbelievable. It's really impressive. Every day when I come in this forum I'm surprised. Thanks to all, gurus! Quote Link to comment Share on other sites More sharing options...
Costinbos77 Posted January 13, 2013 Share Posted January 13, 2013 Dear Madruga_SP, I made a couple of changes to LISP from posting #3, with delightful results. Quote Link to comment Share on other sites More sharing options...
wrha Posted January 13, 2013 Share Posted January 13, 2013 Its very good but if we can extract legth for each line of that poly line it will be very good thing Quote Link to comment Share on other sites More sharing options...
fixo Posted January 13, 2013 Share Posted January 13, 2013 Its very good but if we can extract legth for each line of that poly line it will be very good thing Post the screenshot of Excel file, I didn't understand how the values will be stored row by row Quote Link to comment Share on other sites More sharing options...
wrha Posted January 13, 2013 Share Posted January 13, 2013 fixo i hope that attached can be clear Quote Link to comment Share on other sites More sharing options...
Costinbos77 Posted January 13, 2013 Share Posted January 13, 2013 (edited) I completed the Lisp with calculation of distances . 1. These distances should to appear in dwg? If yes, on a different layer at the surface? Be text or "dimension"? 2. The texts have a specific height? (defun C:aa (/ ar ars cale d f ht i j k lc lis llis llc lsel p1 p2 pm pi2 3pi2 2pi nobi nobv ob sel str sx sy td u x y ) (setvar "cmdecho" 0) ; V : 14 . 01 . 2013 , 13 . 01 . 2013 , 12 . 01 . 2013 . C:PreSup (setq osm (getvar "osmode") ) (setvar "osmode" 0) (if (setq ht 0.2 lsel 0 ob (car (entsel "\n C:PreSup : V : 13 . 01 . 2013 ;\n Select an Object for LAYER : < Pick > : ")) ) (progn (command "zoom" "e") (setq str (cdr (assoc 8 (entget ob)) ) ) ;_ end of setq (princ (strcat "\n Select Objects for LAYER : " str " ; \n < Pick > ; Enter = Whole Layer : ")) (if (not (setq sel (ssget (list '(0 . "LWPOLYLINE,POLYLINE") (cons 8 str)) )) ) (setq sel (ssget "X" (list '(0 . "LWPOLYLINE,POLYLINE") (cons 8 str)) ) ) ) ;_ end of if not (if sel (progn (command "zoom" "o" sel "") (sssetfirst nil sel) ; Selectare Vizualizare Selectie ! (if (/= (getstring (strcat "\n SELECTED objects on LAYER : " str " ;\n Any = NO ; Enter = OK : ")) "") (setq sel nil)) (sssetfirst sel) ; DeSelectare Vizualizare Selectie ! ) ) ; if sel (if sel (progn (or (vl-load-com)) (command "_layer" "m" "Area Text" "c" 1 "Area Text" "") (setq lsel (sslength sel) cale (strcat (getvar "dwgprefix") (getvar "dwgname") " - " (rtos (getvar "cdate") 2 6) ".csv") f (open cale "w") pi2 (/ pi 2) 3pi2 (* pi2 3) 2pi (* pi 2) i 0) (write-line "\nLabel, Area,D 1,D 2, D 3,D 4,D 5,D 6, D 7\n-------------------------------" f) (while (< i lsel) (setq nobi (ssname sel i) nobv (vlax-ename->vla-object nobi) ar (vla-get-Area nobv) i (1+ i) ) (if (> ar 0) (progn (setq lc (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates nobv))) llc (length lc) n (/ llc 2.) ars (rtos ar 2 5) j 0 sx 0 sy 0 lis nil) (while (< j llc) (setq x (nth j lc) sx (+ x sx) j (1+ j) y (nth j lc) sy (+ y sy) j (1+ j) lis (cons (list x y) lis) ) ) ; wh (setq llis (length lis) k 0 td "") (while (< k llis) (setq p1 (nth k lis) k (1+ k) p2 (nth (if (= k llis) 0 k) lis) ) (setq d (distance p1 p2) u (angle p1 p2) td (strcat td ", " (rtos d 2 5)) pm (mapcar '/ (mapcar '+ p1 p2) '(2. 2.) ) ) (if (and (> u pi2) (< u 3pi2)) (setq u (+ u pi)) ) (if (> u 2pi) (setq u (- u 2pi)) ) (entmake (list '(0 . "TEXT") (cons 8 "Area Text") '(10 0 0 0) (cons 40 ht) (cons 1 (strcat (rtos d 2 3) " m")) ;'(7 . "Arial") (cons 50 u) '(72 . 4) (append '(11) pm) ) ) ;_ end of entmake ;;; (command "text" "m" pm ht u (strcat (rtos d 2 3) )) ) ; wh (< k llis) (command "text" "m" (list (/ sx n) (/ sy n) 0) ht 0 (strcat "\n Area " (itoa i) " = " ars)) (write-line (strcat "Area " (itoa i) ", " ars td) f) (princ (strcat "\n Area " (itoa i) " : " ars )) ) ) ; if (> ar 0) ) ; wh < (if (and cale (findfile cale)) (close f)) ) ) ; if sel )) ; if ob (setvar "osmode" osm) (setvar "clayer" "0") (setvar "cmdecho" 1) (princ (strcat "\n Height of Texts : " (rtos ht 2 5) "\n Number of Areas : " (itoa lsel) " .")) (princ "\n END !") (princ) ) Edited January 17, 2013 by Costinbos77 Quote Link to comment Share on other sites More sharing options...
fixo Posted January 13, 2013 Share Posted January 13, 2013 (edited) [ATTACH=CONFIG]39579[/ATTACH]fixo i hope that attached can be clear Sorry your piccy is bad How to write X,Y coordinates in this cells? Show me please, what you want to add in every cell Without your good screen shot try this, very limited tested (defun C:ARXL (/ acsp adoc ar area centpoint col epar fname inspt leg leg_list n perim plent pline_data plineobj regionobj row spar sset thgt tot tst tsz txtobj xlapp xlbook xlbooks xlcells xldata xlsheet xlsheets) (vl-load-com) ;;;local defun (defun setcelltext(cells row column value) (vl-catch-all-apply 'vlax-put-property (list cells 'Item row column (vlax-make-variant (vl-princ-to-string value) )) ) ;;----------------------------- main part ---------------------;; (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object)))) (or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc)))) (vla-startundomark adoc) (setq tsz (getvar "textsize")) (setq tst (getvar "textstyle")) ;; set text style you need: (setvar "textstyle" "Standard") ;; set text size (setq thgt (getdist "\nText Height: ")) (if (not thgt)(setq thgt (getvar "dimtxt"))) (setvar "textsize" thgt) (princ "\n\t---\tSelect contours\t---") (setq sset (ssget '( (0 . "LWPOLYLINE") (8 . "ANNO-AREA"); <-- set layer of polygons (-4 . "<OR") (70 . 1);flag for closed curve, linetype generation disabled (70 . 129);flag for closed curve, linetype generation enabled (-4 . "OR>") ) ) ) (setq n 1 tot 0.0) (while (setq plent (ssname sset 0)) (setq leg_list nil) (setq plineObj (vlax-ename->vla-object plent)) (setq spar (vlax-curve-getstartparam plineObj) epar (vlax-curve-getendparam plineObj)) (while (< spar epar) (setq leg (- (vlax-curve-getdistatparam plineObj(+ spar 1))(vlax-curve-getdistatparam plineObj spar)) leg_list (cons (rtos leg 2 2) leg_list)) (setq spar (1+ spar))) (setq leg_list (reverse leg_list)) (setq ar (vla-get-area plineObj) perim (rtos (vla-get-length plineObj) 2 2) tot (+ tot ar) area (rtos ar 2 2) ) (setq regionObj (car (vlax-invoke acsp 'addregion (list plineObj)))) (setq centPoint (trans (vlax-get regionObj 'centroid) 1 0)) (setq inspt (vlax-3d-point centPoint)) (setq txtobj (vla-addtext acsp (strcat "Label-"(itoa n)) inspt thgt)) (vla-put-alignment txtobj acAlignmentMiddleCenter) (vla-put-textalignmentpoint txtobj inspt) (vla-put-insertionpoint txtobj inspt) (setq pline_data nil) (setq pline_data (append pline_data (append (append (list (strcat "Label-"(itoa n)) area)(list perim) leg_list)))) (setq xldata (append xldata (list pline_data))) (vl-catch-all-apply '(lambda() (progn (vla-delete regionObj) (vlax-release-object regionObj) ))) (setq n (1+ n)) (ssdel plent sset) ) (print xldata) (princ "\nTotal: ") (print tot) ;;------------------------ Excel part ----------------------------;; (setq xlapp (vlax-get-or-create-object "Excel.Application") xlbooks (vlax-get-property xlapp 'Workbooks) xlbook (vlax-invoke-method xlbooks 'Add) xlsheets (vlax-get-property xlbook 'Sheets) xlsheet (vlax-get-property xlsheets 'Item 1) xlcells (vlax-get-property xlsheet 'Cells) ) (vla-put-visible xlapp :vlax-true) (vla-put-name xlsheet "Plan1") (setq row 1) (foreach label xldata (setq col 1) (foreach item label (setcelltext xlcells row col item) (setq col (1+ col) ) ) (setq row (1+ row) ) ) (setcelltext xlcells row 1 "Total:") (setcelltext xlcells row 2 (rtos tot 2 2));<-- precision 2 decimal (vlax-invoke-method (vlax-get-property xlsheet 'Columns) 'AutoFit) (setq fname (strcat (getvar "dwgprefix")(vl-string-right-trim ".dwg" (getvar "dwgname")) ".xls")) (vlax-invoke-method xlbook 'SaveAs fname nil nil nil :vlax-false :vlax-false 1 2 ) (vlax-invoke-method xlbook 'Close) (gc) (vlax-invoke-method xlapp 'Quit) (mapcar '(lambda (x) (vl-catch-all-apply '(lambda () (vlax-release-object x) ) ) ) (list xlcells xlsheet xlsheets xlbook xlbooks xlapp) ) (setq xlapp nil) (gc)(gc) (alert (strcat "File saved as:\n" fname)) (setvar "textsize" tsz) (setvar "textstyle" tst) (vla-endundomark adoc) (princ) ) (princ "\n\t---\tStart command with ARXL ...\t---") (prin1) (or (vl-load-com)(princ)) Edited January 13, 2013 by fixo Quote Link to comment Share on other sites More sharing options...
1q2w3e4rr Posted January 14, 2013 Share Posted January 14, 2013 tank you fixo but This code does not select any objects!!!! when i drag and try to select objects , what will be displayed in command line:Select objects: 0 found!!! Quote Link to comment Share on other sites More sharing options...
fixo Posted January 14, 2013 Share Posted January 14, 2013 Change layer "ANNO-AREA" in the selection filter on your own Quote Link to comment Share on other sites More sharing options...
1q2w3e4rr Posted January 14, 2013 Share Posted January 14, 2013 tank you so mach Quote Link to comment Share on other sites More sharing options...
mo70mo70 Posted January 24, 2013 Share Posted January 24, 2013 How to create texts to "name" closed polylines and export "names" and area to active cell excel iam mohmed fawzy mo70mo70@yahoo.com Quote Link to comment Share on other sites More sharing options...
mo70mo70 Posted January 24, 2013 Share Posted January 24, 2013 How to create texts to "name" closed polylines and export "names" and area to active cell excel iam mohmed fawzy 1- select active cell 2-slesct poly lines 3-put area in active cell mo70mo70@yahoo.com Quote Link to comment Share on other sites More sharing options...
mo70mo70 Posted May 29, 2013 Share Posted May 29, 2013 How to create texts to "name" closed polylines and export "names" and area to active cell excel iam mohmed fawzy 1- select active cell 2-slesct poly lines Quote Link to comment Share on other sites More sharing options...
Stephen316 Posted July 11, 2014 Share Posted July 11, 2014 Dear Costinbos77, The code that you have provided was very useful, but can i ask you for one more favour?? The code now extracts the area of polylines and adds a area label and saves in .csv format. Can you please modify the code to print the area labels in drawing itself?? without area labels in drawing it becomes difficult to locate them, in my case i have close to 250 areas to locate. Thanks in advance Stephen 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.