aridzv Posted January 10, 2023 Share Posted January 10, 2023 (edited) Hi. I hvave a lisp (see attached Area_To_Text_Polygon_M2C). this lisp do: 1. promt the user to select a single polygon. 2. prompt the user to select text insertion point. what I'm lookig to do is: 1. promt the user to select multiple polygons. 2. in a loop: a. calculate each polygon area. b. insert the area text in the geometric center of each polygon is something like that possible? aridzv *EDIT: I have other lisp that do the same,only using picked boundery (pick a point inside a polygon) - maybe it will be easier to use that one and use the pick point of every closed boundery as the text inset point? see attached Area_To_Text_Boundery_M2A.lsp. Area_To_Text_Polygon_M2C.lspArea_To_Text_Boundery_M2A.lsp Edited January 10, 2023 by aridzv Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted January 10, 2023 Share Posted January 10, 2023 (edited) I started from scratch. Is this how you want is? Bottom function: adapt the text height to your likings . Now: (setq hgt 2.5) ;;1. promt the user to select multiple polygons. ;;2. in a loop: ;; a. calculate each polygon area. ;; b. insert the area text in the geometric center of each polygon (vl-load-com) ;; Multiple assoc. Returns a list of all requested (assoc) with set key ; use like this (massoc 10 YourListOfData) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; main function (defun wamp (pline hgt / area pt str vert_pts x y p) (setq area (vla-get-area (vlax-ename->vla-object pline) )) ;; get the vertex positions. (setq vert_pts (massoc 10 (entget pline))) (setq x 0.0) (setq y 0.0) ;; Then calculate the average. Sum of x and y values divided by the number of vertices (foreach p vert_pts (setq x (+ x (nth 0 p))) (setq y (+ y (nth 1 p))) ) (setq pt (list (/ x (length vert_pts)) (/ y (length vert_pts)) )) ;; make a string out of the area float. Here would be the place to add a prefix or postfix. Example: ;; (setq str (strcat "area: " (rtos area 2 3) )) (setq str (rtos area 2 3)) ;; that 3 means 3 decimals. Feel free to change this (drawText pt hgt str) (princ ) ) ;; WAMP for Write Area in the Middle of Polyline (defun c:wamp ( / pline ss i hgt) ;; User setting. Set to your liking (setq hgt 2.5) ;; user selects polylines (princ "\nSelect polylines: ") (setq ss (ssget (list (cons 0 "*POLYLINE")))) ;; loop of the elements (setq i 0) (repeat (sslength ss) (setq pline (ssname ss i)) (wamp pline hgt) (setq i (+ i 1)) ) ) Edited January 10, 2023 by Emmanuel Delay 1 1 Quote Link to comment Share on other sites More sharing options...
aridzv Posted January 10, 2023 Author Share Posted January 10, 2023 @Emmanuel Delay AMAIZING- THANKS!! how complicate is to do the same for selection by internal point like the second lisp I have posted (Area_To_Text_Boundery_M2A.lsp)? I looked for an exampels of creating a selection set by choosing internal points like in the command for a single object: (command "-Boundary" a "") but could'nt find any. many thanks, aridzv. 1 Quote Link to comment Share on other sites More sharing options...
mhupp Posted January 10, 2023 Share Posted January 10, 2023 http://www.lee-mac.com/arealabel.html Quote Link to comment Share on other sites More sharing options...
aridzv Posted January 10, 2023 Author Share Posted January 10, 2023 (edited) @Emmanuel Delay I have one more question - Iv'e tried to change the rext justification to middle center like this: ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 73 2) (cons 72 1) (cons 1 str)))) but when I do that all the text items are put to 0,0,0 (ignore cons 10 pt). is there a way to fix it? *EDIT: cons 11 is the solution... when using cons 72 & cons 73 must assign the insertion point to cons 11 as well.. ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 11 pt) (cons 10 pt) (cons 40 (getvar "TEXTSIZE")) (cons 7 (getvar "TEXTSTYLE")) (cons 73 2) (cons 72 1) (cons 1 str)))) I've also attched a screenshot from the DXF Reference guide (Capture1.JPG) Edited January 10, 2023 by aridzv 1 Quote Link to comment Share on other sites More sharing options...
aridzv Posted January 10, 2023 Author Share Posted January 10, 2023 (edited) 2 hours ago, mhupp said: http://www.lee-mac.com/arealabel.html well,it dosen't what I need... what I'm looking for help with is a way to click inside a closed polylines one after the other, and when I'm done to let the lisp to put the area text inside each one of them. is somthing like that is possible? Edited January 10, 2023 by aridzv Quote Link to comment Share on other sites More sharing options...
Tsuky Posted January 10, 2023 Share Posted January 10, 2023 I have this with field It work's with entities selection or boundarie (vl-load-com) (defun c:surf_curve-closed ( / AcDoc Space loop js pt_in new_pl area_obj nw_obj ename ent_text dxf_ent key) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) loop T ) (princ "\nSelect a closed object or <Enter/Right-click> for a point in interior of area") (while loop (setq js (ssget "_+.:E:S" '( (-4 . "<OR") (-4 . "<AND") (0 . "*POLYLINE") (-4 . "<AND") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "AND>") (0 . "CIRCLE") (-4 . "<AND") (0 . "SPLINE") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "<AND") (0 . "ELLIPSE") (41 . 0.0) (42 . 6.283185307179586) (-4 . "AND>") (-4 . "OR>") ) ) area_obj nil ) (cond ((null js) (setq pt_in (getpoint "\nGive interior point or <Enter/Right-click> for quit?: ") new_pl (bpoly pt_in nil '(0 0 1)) ) (if (eq (type new_pl) 'ENAME) (setq area_obj (vlax-get-property (setq ename (vlax-ename->vla-object new_pl)) "Area")) (setq loop nil) ) ) (T (setq area_obj (vlax-get-property (setq ename (vlax-ename->vla-object (ssname js 0))) "Area")) ) ) (cond (area_obj (if (zerop (getvar "USERR1")) (setvar "USERR1" (/ (getvar "VIEWSIZE") 75.0))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr3\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (getvar "USERR1") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 256) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent) ) (entmod dxf_ent) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) ) (vlax-put (vlax-ename->vla-object (entlast)) 'TextString (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr3\">%" ) ) ) (T (setq loop nil)) ) (princ "\nSelect a closed object or <Enter/Right-click> for a point in interior of area") ) (prin1) ) Quote Link to comment Share on other sites More sharing options...
aridzv Posted January 11, 2023 Author Share Posted January 11, 2023 23 hours ago, Tsuky said: I have this with field It work's with entities selection or boundarie (vl-load-com) (defun c:surf_curve-closed ( / AcDoc Space loop js pt_in new_pl area_obj nw_obj ename ent_text dxf_ent key) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) loop T ) (princ "\nSelect a closed object or <Enter/Right-click> for a point in interior of area") (while loop (setq js (ssget "_+.:E:S" '( (-4 . "<OR") (-4 . "<AND") (0 . "*POLYLINE") (-4 . "<AND") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "AND>") (0 . "CIRCLE") (-4 . "<AND") (0 . "SPLINE") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "<AND") (0 . "ELLIPSE") (41 . 0.0) (42 . 6.283185307179586) (-4 . "AND>") (-4 . "OR>") ) ) area_obj nil ) (cond ((null js) (setq pt_in (getpoint "\nGive interior point or <Enter/Right-click> for quit?: ") new_pl (bpoly pt_in nil '(0 0 1)) ) (if (eq (type new_pl) 'ENAME) (setq area_obj (vlax-get-property (setq ename (vlax-ename->vla-object new_pl)) "Area")) (setq loop nil) ) ) (T (setq area_obj (vlax-get-property (setq ename (vlax-ename->vla-object (ssname js 0))) "Area")) ) ) (cond (area_obj (if (zerop (getvar "USERR1")) (setvar "USERR1" (/ (getvar "VIEWSIZE") 75.0))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr3\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (getvar "USERR1") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 256) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent) ) (entmod dxf_ent) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) ) (vlax-put (vlax-ename->vla-object (entlast)) 'TextString (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr3\">%" ) ) ) (T (setq loop nil)) ) (princ "\nSelect a closed object or <Enter/Right-click> for a point in interior of area") ) (prin1) ) thanks for the reply!! I tried to use your program, but I couldn't quite understand how it works.... But anyway, thanks for the response!! aridzv. Quote Link to comment Share on other sites More sharing options...
CADWORKER Posted August 20, 2023 Share Posted August 20, 2023 On 1/10/2023 at 4:39 PM, Emmanuel Delay said: I started from scratch. Is this how you want is? Bottom function: adapt the text height to your likings . Now: (setq hgt 2.5) ;;1. promt the user to select multiple polygons. ;;2. in a loop: ;; a. calculate each polygon area. ;; b. insert the area text in the geometric center of each polygon (vl-load-com) ;; Multiple assoc. Returns a list of all requested (assoc) with set key ; use like this (massoc 10 YourListOfData) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; main function (defun wamp (pline hgt / area pt str vert_pts x y p) (setq area (vla-get-area (vlax-ename->vla-object pline) )) ;; get the vertex positions. (setq vert_pts (massoc 10 (entget pline))) (setq x 0.0) (setq y 0.0) ;; Then calculate the average. Sum of x and y values divided by the number of vertices (foreach p vert_pts (setq x (+ x (nth 0 p))) (setq y (+ y (nth 1 p))) ) (setq pt (list (/ x (length vert_pts)) (/ y (length vert_pts)) )) ;; make a string out of the area float. Here would be the place to add a prefix or postfix. Example: ;; (setq str (strcat "area: " (rtos area 2 3) )) (setq str (rtos area 2 3)) ;; that 3 means 3 decimals. Feel free to change this (drawText pt hgt str) (princ ) ) ;; WAMP for Write Area in the Middle of Polyline (defun c:wamp ( / pline ss i hgt) ;; User setting. Set to your liking (setq hgt 2.5) ;; user selects polylines (princ "\nSelect polylines: ") (setq ss (ssget (list (cons 0 "*POLYLINE")))) ;; loop of the elements (setq i 0) (repeat (sslength ss) (setq pline (ssname ss i)) (wamp pline hgt) (setq i (+ i 1)) ) ) Hi Emmanuel Delay, is it possible to put the text in the layer of the closed polygons? Also is this possible to reduce the area, if there is a small closed polygon within the bigger polygon can the area of the bigger polygon be reduced? Quote Link to comment Share on other sites More sharing options...
symoin Posted August 20, 2023 Share Posted August 20, 2023 @Cadworker look for leeMac's area lisps you may have options for this. Or else after getting the area for all the closed topology you can try manually doing the subtractions. or look for some ways to do in Arcmap. Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted August 21, 2023 Share Posted August 21, 2023 21 hours ago, CADWORKER said: Hi Emmanuel Delay, is it possible to put the text in the layer of the closed polygons? Also is this possible to reduce the area, if there is a small closed polygon within the bigger polygon can the area of the bigger polygon be reduced? Sure. Replace this function. I didn't touch the rest ;; WAMP for Write Area in the Middle of Polyline (defun c:wamp ( / pline ss i hgt clay lay) ;; current layer (setq clay (getvar "CLAYER")) ;; User setting. Set to your liking (setq hgt 2.5) ;; user selects polylines (princ "\nSelect polylines: ") (setq ss (ssget (list (cons 0 "*POLYLINE")))) ;; loop of the elements (setq i 0) (repeat (sslength ss) (setq pline (ssname ss i)) ;; set layer of polyline to current (setvar "CLAYER" (setq lay (cdr (assoc 8 (entget pline)))) ) (wamp pline hgt) (setq i (+ i 1)) ) (setvar "CLAYER" clay) ) Quote Link to comment Share on other sites More sharing options...
XDSoft Posted April 10 Share Posted April 10 [XDrX-PlugIn(134)] Land plot (Polygon) analysis statistics (theswamp.org) https://www.theswamp.org/index.php?topic=59435.0 (defun c:xdtb_pl-analyze (/ #area #centroid #length #numverts #xd-var-global-text-height end-row height i lst minl mtxt n pt pts ss start-row str tbl temp tlst tlst1 verts w x ) (xd::doc:getdouble (xdrx-string-multilanguage "\n文字高度:" "\nText Height:") "#xd-var-global-text-height" (setq height (xd::doc:getpickboxheight)) ) (if (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n选择封闭的多段线<退出>:" "\nSelect Closed Polyline<Exit>:" ) '((0 . "*POLYLINE") (-4 . "&=") (70 . 1) ) ) ) (progn (xdrx-begin) (setq lst (xdrx-entity-getproperty ss "boundingbox")) (setq lst (mapcar '(lambda (x) (setq temp (car x)) (min (distance (car temp) (cadr temp)) (distance (cadr temp) (caddr temp)) ) ) lst ) ) (setq minl (apply 'min lst ) ) (xdrx-document-setprec (/ minl 2.0)) (setq lst (xd::pickset:tablesort ss 0 3 '< '>) i 0 verts nil tlst nil ) (mapcar '(lambda (x) (xdrx-getpropertyvalue x "centroid" "area" "length" "numverts") (setq verts (cons (list (setq i (1+ i)) #numverts ) verts ) ) (setq mtxt (xdrx-mtext-make #centroid (setq str (xdrx-string-formatex "%d\nL=%.1f\nS=%.2f" i #length #area ) ) 1.0 #xd-var-global-text-height ) ) (xdrx-setpropertyvalue mtxt "attachment" 5) (setq pts (xdrx-getpropertyvalue x "vertices") pts (xd::pnts:open pts) #numverts (length pts)) (foreach n pts (setq tlst (cons (list i #numverts (rtos #length 2 4) (rtos #area 2 4) (rtos (car n) 2 4) (rtos (cadr n) 2 4) (rtos (caddr n) 2 4) ) tlst ) ) ) ) (xd::list:flat lst) ) (setq tlst (reverse tlst)) (setq tlst (cons (list (xdrx-string-multilanguage "地块统计表" "Plot Statistics Table") nil nil nil nil nil nil ) (cons (list (xdrx-string-multilanguage "编号" "P&N") (xdrx-string-multilanguage "顶点数" "N&V") (xdrx-string-multilanguage "长度" "Length") (xdrx-string-multilanguage "面积" "Area") (xdrx-string-multilanguage "X坐标" "X coordinate") (xdrx-string-multilanguage "Y坐标" "Y coordinate") (xdrx-string-multilanguage "Z坐标" "Z coordinate") ) tlst ) ) ) (if (setq pt (getpoint (xdrx-string-multilanguage "\n表格插入点<退出>:" "\nTable Insert Point<Exit>:"))) (progn (setq w (* (xd::var:getratio) #xd-var-global-text-height)) (xd::table:makefromlist tlst pt w (/ w 2.0)) (setq tbl (entlast)) (setq verts (reverse verts) start-row 2 ) (foreach n verts (setq end-row (1- (+ start-row (last n)))) (xdrx_table_MergeCells tbl start-row end-row 0 0) (xdrx_table_MergeCells tbl start-row end-row 1 1) (xdrx_table_MergeCells tbl start-row end-row 2 2) (xdrx_table_MergeCells tbl start-row end-row 3 3) (setq start-row (1+ end-row)) ) ) ) (xdrx-end) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
aaron.gonzalez Posted May 14 Share Posted May 14 On 4/9/2024 at 9:31 PM, XDSoft said: [XDrX-PlugIn(134)] Land plot (Polygon) analysis statistics (theswamp.org) https://www.theswamp.org/index.php?topic=59435.0 (defun c:xdtb_pl-analyze (/ #area #centroid #length #numverts #xd-var-global-text-height end-row height i lst minl mtxt n pt pts ss start-row str tbl temp tlst tlst1 verts w x ) (xd::doc:getdouble (xdrx-string-multilanguage "\n文字高度:" "\nText Height:") "#xd-var-global-text-height" (setq height (xd::doc:getpickboxheight)) ) (if (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n选择封闭的多段线<退出>:" "\nSelect Closed Polyline<Exit>:" ) '((0 . "*POLYLINE") (-4 . "&=") (70 . 1) ) ) ) (progn (xdrx-begin) (setq lst (xdrx-entity-getproperty ss "boundingbox")) (setq lst (mapcar '(lambda (x) (setq temp (car x)) (min (distance (car temp) (cadr temp)) (distance (cadr temp) (caddr temp)) ) ) lst ) ) (setq minl (apply 'min lst ) ) (xdrx-document-setprec (/ minl 2.0)) (setq lst (xd::pickset:tablesort ss 0 3 '< '>) i 0 verts nil tlst nil ) (mapcar '(lambda (x) (xdrx-getpropertyvalue x "centroid" "area" "length" "numverts") (setq verts (cons (list (setq i (1+ i)) #numverts ) verts ) ) (setq mtxt (xdrx-mtext-make #centroid (setq str (xdrx-string-formatex "%d\nL=%.1f\nS=%.2f" i #length #area ) ) 1.0 #xd-var-global-text-height ) ) (xdrx-setpropertyvalue mtxt "attachment" 5) (setq pts (xdrx-getpropertyvalue x "vertices") pts (xd::pnts:open pts) #numverts (length pts)) (foreach n pts (setq tlst (cons (list i #numverts (rtos #length 2 4) (rtos #area 2 4) (rtos (car n) 2 4) (rtos (cadr n) 2 4) (rtos (caddr n) 2 4) ) tlst ) ) ) ) (xd::list:flat lst) ) (setq tlst (reverse tlst)) (setq tlst (cons (list (xdrx-string-multilanguage "地块统计表" "Plot Statistics Table") nil nil nil nil nil nil ) (cons (list (xdrx-string-multilanguage "编号" "P&N") (xdrx-string-multilanguage "顶点数" "N&V") (xdrx-string-multilanguage "长度" "Length") (xdrx-string-multilanguage "面积" "Area") (xdrx-string-multilanguage "X坐标" "X coordinate") (xdrx-string-multilanguage "Y坐标" "Y coordinate") (xdrx-string-multilanguage "Z坐标" "Z coordinate") ) tlst ) ) ) (if (setq pt (getpoint (xdrx-string-multilanguage "\n表格插入点<退出>:" "\nTable Insert Point<Exit>:"))) (progn (setq w (* (xd::var:getratio) #xd-var-global-text-height)) (xd::table:makefromlist tlst pt w (/ w 2.0)) (setq tbl (entlast)) (setq verts (reverse verts) start-row 2 ) (foreach n verts (setq end-row (1- (+ start-row (last n)))) (xdrx_table_MergeCells tbl start-row end-row 0 0) (xdrx_table_MergeCells tbl start-row end-row 1 1) (xdrx_table_MergeCells tbl start-row end-row 2 2) (xdrx_table_MergeCells tbl start-row end-row 3 3) (setq start-row (1+ end-row)) ) ) ) (xdrx-end) ) ) (princ) ) PLEASE, CAN YOU MODIFY TO FIX LISP, THIS SHARE THIS MASSAGE: error: no function definition: XDRX-STRING-MULTILANGUAGE Quote Link to comment Share on other sites More sharing options...
ronaldcheung108 Posted June 24 Share Posted June 24 On 1/10/2023 at 9:39 PM, Emmanuel Delay said: I started from scratch. Is this how you want is? Bottom function: adapt the text height to your likings . Now: (setq hgt 2.5) ;;1. promt the user to select multiple polygons. ;;2. in a loop: ;; a. calculate each polygon area. ;; b. insert the area text in the geometric center of each polygon (vl-load-com) ;; Multiple assoc. Returns a list of all requested (assoc) with set key ; use like this (massoc 10 YourListOfData) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun drawText (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; main function (defun wamp (pline hgt / area pt str vert_pts x y p) (setq area (vla-get-area (vlax-ename->vla-object pline) )) ;; get the vertex positions. (setq vert_pts (massoc 10 (entget pline))) (setq x 0.0) (setq y 0.0) ;; Then calculate the average. Sum of x and y values divided by the number of vertices (foreach p vert_pts (setq x (+ x (nth 0 p))) (setq y (+ y (nth 1 p))) ) (setq pt (list (/ x (length vert_pts)) (/ y (length vert_pts)) )) ;; make a string out of the area float. Here would be the place to add a prefix or postfix. Example: ;; (setq str (strcat "area: " (rtos area 2 3) )) (setq str (rtos area 2 3)) ;; that 3 means 3 decimals. Feel free to change this (drawText pt hgt str) (princ ) ) ;; WAMP for Write Area in the Middle of Polyline (defun c:wamp ( / pline ss i hgt) ;; User setting. Set to your liking (setq hgt 2.5) ;; user selects polylines (princ "\nSelect polylines: ") (setq ss (ssget (list (cons 0 "*POLYLINE")))) ;; loop of the elements (setq i 0) (repeat (sslength ss) (setq pline (ssname ss i)) (wamp pline hgt) (setq i (+ i 1)) ) ) Hi Emmanuel Delay, may I know how to make the area divide by 1e^-6 ? Also may I know how to turn the text align to the UCS's x-axis ? Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted June 27 Share Posted June 27 See if this helps. In function WAMP (setq area (/ (vla-get-area (vlax-ename->vla-object pline) 0.000001 ) ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted June 27 Share Posted June 27 (edited) This may be useful a single line finds the geometric centre of a pline. Thnaks to Kent Cooper for hint about Gcen (setq pt (osnap (vlax-curve-getStartPoint obj) "gcen")) Edited June 27 by BIGAL 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.