lmcgill2 Posted March 1, 2011 Share Posted March 1, 2011 Hello all, this is my first post so I hope I don't screw this up. My company uses a LISP routine to calculate areas of polygons in our drawings. ;; local defun ;; get center of closed object (defun getcenter (obj / acsp cen rgn) (setq acsp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) rgn (car (vlax-invoke acsp 'Addregion (list obj))) cen (vlax-get rgn 'Centroid) ) (vla-delete rgn) cen ) ;; main part ;; label [plines w]/area field in sq. meters (defun c:a3 (/ acsp adoc axss cpt ins ss txt mtxtobj) (vl-load-com) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (or acsp (setq acsp (vla-get-modelspace adoc ) ) ) (if (setq ss (ssget (list (cons 0 "*POLYLINE,*CONTOUR")))) (progn (setq axss (vla-get-activeselectionset adoc)) ;; iterate through the active selection set collection (vlax-for obj axss ; get a curve center (setq cpt (trans (getcenter obj) 0 1)) (setq txt ; displayed in meters to 3 decimal place: ;;; (strcat "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " ;;; (itoa (vlax-get obj 'ObjectID)) ;;; ">%).Area [url="file://\\f"]\\f[/url] \"%lu2%pr3%ps[, m2]%ct8[1e-006]\">%" ;;; ) ;;; ; displayed in engineering to 2 decimal place: ;;; (strcat "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " ;;; (itoa (vlax-get obj 'ObjectID)) ;;; ">%).Area [url="file://\\f"]\\f[/url] \"%pr0%lu2%ct4%qf1\">%");<--pr2 means 2 decimal places, change to your suit ; displayed in engineering to 2 decimal place with addition SQ. FT.: (strcat "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " (itoa (vlax-get obj 'ObjectID)) ">%).Area [url="file://\\f"]\\f[/url] \"%pr0%lu2%ct4%qf1 SQ. FT.\">%") ) ; add mtext object to model space (setq mtxtobj (vlax-invoke acsp 'AddMText cpt ;insertion point 0.0 ; mtext width, optional = 0 txt ;string (field value) )) ; change mtext height accordingly to current dimension style text height: (vlax-put mtxtobj 'Height (getvar "dimtxt")); change (getvar "dimtxt") on text height you need ; set justifying to middle center (vlax-put mtxtobj 'AttachmentPoint acAttachmentPointMiddleCenter) ) ) ) (vla-regen adoc acactiveviewport) (princ) ) (princ "\n Type A3 to label objects with area field") (princ) I have no idea where this code came from because it was here long before I was. Anyway, I do have some programming knowledge, but I'm having trouble figureing out what is going on here. What I'd like this routine to do is to lable an area at 1/4 of the actual area. That is, if the polygon is 100 sq. ft., I'd like the label to read "25 SQ. FT." Any ideas? Thanks for any help. Quote Link to comment Share on other sites More sharing options...
Hippe013 Posted March 1, 2011 Share Posted March 1, 2011 Imcgill2, Welcome to Cadtutor. In looking at the posted code the area is retrieved using a "Field Expression". The expression is stored in the txt variable. I don't see a way that you are able to retrieve the actual area to manipulate while still using this field expression method. Then again I am pretty rusty when it comes to using field expressions. There are, on the other hand, other ways to achieve what you are trying to do without using the field expressions. I hope that this helps. regards, Hippe013 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 1, 2011 Share Posted March 1, 2011 Welcome to CADTutor - and don't worry, you haven't screwed up Give this a try: (defun c:a3 ( / _center acdoc acspc acsel mObj ) (vl-load-com) ;; Lee Mac 2011 (defun _center ( space obj / reg cen ) (setq reg (car (vlax-invoke space 'addregion (list obj))) cen (vlax-get reg 'centroid) ) (vla-delete reg) cen ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)) ) (if (ssget '((0 . "*POLYLINE,*CONTOUR"))) (progn (vlax-for obj (setq acsel (vla-get-ActiveSelectionSet acdoc)) (setq mObj (vlax-invoke acspc 'AddMText (setq pt (trans (_center acspc obj) 1 0)) 0.0 (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-objectid obj)) ">%).Area \\f \"%lu2%pr0%ps[, SQ. FT.]%ct8[0.001736111111111111]\">%" ) ) ) (vla-put-height mObj (getvar 'DIMTXT)) (vla-put-attachmentpoint mObj acAttachmentPointMiddleCenter) (vlax-put mObj 'InsertionPoint pt) ) (vla-delete acsel) ) ) (princ) ) I've also fixed a few other things relating to changes in UCS etc. Quote Link to comment Share on other sites More sharing options...
Hippe013 Posted March 2, 2011 Share Posted March 2, 2011 Lee, I was wondering if you had any sort of reference or could point to an area that explained the field expressions and how they are used. regards, Hippe013 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 2, 2011 Share Posted March 2, 2011 I was wondering if you had any sort of reference or could point to an area that explained the field expressions and how they are used. Hi Hippe, I usually just use the Field command: I create the field I wish to use and take note of the field expression at the bottom of the dialog - it is usually clear how the various elements fit together after a bit of experimenting. Lee Quote Link to comment Share on other sites More sharing options...
alanjt Posted March 2, 2011 Share Posted March 2, 2011 Wouldn't this be what he would need to decrease square footage by 1/4? (defun c:a3 (/ _center acdoc acspc acsel mObj) (vl-load-com) (defun _center (space obj / reg cen) (setq reg (car (vlax-invoke space 'addregion (list obj))) cen (vlax-get reg 'centroid) ) (vla-delete reg) cen ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace ) ) ) (if (ssget '((0 . "*POLYLINE,*CONTOUR"))) (progn (vlax-for obj (setq acsel (vla-get-ActiveSelectionSet acdoc)) (setq mObj (vlax-invoke acspc 'AddMText (setq pt (trans (_center acspc obj) 1 0)) 0.0 (strcat "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid obj)) ">%).Area \\f \"%lu2%pr0\">% / 4.) \\f \"%lu2%pr0%ps[, SQ FT.]\">%" ) ) ) (vla-put-height mObj (getvar 'DIMTXT)) (vla-put-attachmentpoint mObj acAttachmentPointMiddleCenter) (vlax-put mObj 'InsertionPoint pt) ) (vla-delete acsel) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 2, 2011 Share Posted March 2, 2011 I suppose that would work as well - I just used a conversion factor instead of an expression. Quote Link to comment Share on other sites More sharing options...
alanjt Posted March 2, 2011 Share Posted March 2, 2011 I suppose that would work as well - I just used a conversion factor instead of an expression. I was wondering what you were doing. I couldn't get yours to work. Quote Link to comment Share on other sites More sharing options...
symoin Posted April 16, 2011 Share Posted April 16, 2011 Wouldn't this be what he would need to decrease square footage by 1/4? (defun c:a3 (/ _center acdoc acspc acsel mObj) (vl-load-com) (defun _center (space obj / reg cen) (setq reg (car (vlax-invoke space 'addregion (list obj))) cen (vlax-get reg 'centroid) ) (vla-delete reg) cen ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace ) ) ) (if (ssget '((0 . "*POLYLINE,*CONTOUR"))) (progn (vlax-for obj (setq acsel (vla-get-ActiveSelectionSet acdoc)) (setq mObj (vlax-invoke acspc 'AddMText (setq pt (trans (_center acspc obj) 1 0)) 0.0 (strcat "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid obj)) ">%).Area \\f \"%lu2%pr0\">% / 4.) \\f \"%lu2%pr0%ps[, SQ FT.]\">%" ) ) ) (vla-put-height mObj (getvar 'DIMTXT)) (vla-put-attachmentpoint mObj acAttachmentPointMiddleCenter) (vlax-put mObj 'InsertionPoint pt) ) (vla-delete acsel) ) ) (princ) ) How to edit it to Sq m & Hectares togather at one time. Quote Link to comment Share on other sites More sharing options...
rouho Posted October 23, 2017 Share Posted October 23, 2017 Hello, Is it possible to have the same code giving the area in 2 decimals? Thanks 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.