Visual LISP, AutoLISP and General Customization
Turn on suggestions Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.
Showing results for
Showonly | Search instead for
Did you mean:
Calculate area in Meter Square
13 REPLIES 13
SOLVED
Back to AutoCAD Customization Category
Back to Topic Listing
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page
- Back to Topic Listing
- Previous
- Next
Message 1 of 14
Anonymous
6682 Views, 13 Replies
10-26-201602:39 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201602:39 AM
Calculate area in Meter Square
This lisp is used to Calculate the area of an object in square feet.1. Please Edit it to calculate in Square meter.
2. Please Edit it to calculate for multiple objects.;;; AreaText.LSP ver 3.0;;; Command name is AT;;; Select a polyline and where to place the text;;; Sample result: 2888.89 SQ. FT.;;; As this is a FIELD it is updated based on the FIELDEVAL;;; or the settings found in the OPTIONS dialog box;;; By Jimmy Bergmark;;; Copyright (C) 2007-2010 JTB World, All Rights Reserved;;; Website: www.jtbworld.com;;; E-mail: info@jtbworld.com;;; 2007-09-05 - First release;;; 2009-08-02 - Updated to work in both modelspace and paperspace;;; 2010-10-29 - Updated to work also on 64-bit AutoCAD;;; Uses TEXTSIZE for the text height(defun Get-ObjectIDx64 (obj / util) (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object)))) (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj))) (if (= (type obj) 'VLA-OBJECT) (if (> (vl-string-search "x64" (getvar "platform")) 0) (vlax-invoke-method util "GetObjectIdString" obj :vlax-False) (rtos (vla-get-objectid obj) 2 0) ) ))(defun c:AT (/ entObject entObjectID InsertionPoint ad) (vl-load-com) (setq entObject (vlax-ename->vla-object(car (entsel))) entObjectID (Get-ObjectIDx64 entObject) InsertionPoint (vlax-3D-Point (getpoint "Select point: ")) ad (vla-get-ActiveDocument (vlax-get-acad-object)) ) (vla-addMText (if (= 1 (vla-get-activespace ad)) (vla-get-modelspace ad) (if (= (vla-get-mspace ad) :vlax-true) (vla-get-modelspace ad) (vla-get-paperspace ad) ) ) InsertionPoint 0.0 (strcat "%<\\AcObjProp Object(%<\\_ObjId " entObjectID ">%).Area \\f \"%pr2%lu2%ct4%qf1 SQ. FT.\">%" )))
Solved!Go to Solution.
Solved by gpcattaneo. Go to Solution.
Report
1Like
Reply
- Back to Topic Listing
- Previous
- Next
13 REPLIES 13
Message 2 of 14
ВeekeeCZ
in reply to:Anonymous
10-26-201603:07 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201603:07 AM
You can try this one... from my archive..
Spoiler
(defun c:PLArea (/ acsp ss e ptList ID StrField txt p) (vl-load-com) (command "_.undo" "_be") (setq acsp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (if (setq ss (ssget ;(progn;(initget 1 "Y N") ;(setq ans (getkword "\nProcess All Polylines [Yes/No]: "));(if (eq "Y" ans) ;"_X" ":L";)) '((0 . "*POLYLINE") ;(8 . "A-AREA-BDRY") (-4 . "&") (70 . 1)(410 . "Model")))) (repeat (sslength ss) (setq e (ssname ss 0) sum '(0 0) verts (cdr (assoc 90 (entget e)))) (setq ptList (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e)))) (foreach x ptList (setq sum (mapcar '+ x sum))) (setq ID (itoa (vla-get-objectid (vlax-ename->vla-object e)))) (setq StrField (strcat "%<\\AcObjProp Object(%<\\_ObjId " ID ">%).Area \\f \"%lu2\">%")) (vla-put-AttachmentPoint (setq txt (vla-addMText acsp (setq p (vlax-3d-point (mapcar '/ sum (list verts verts)))) 0 StrField)) acAttachmentPointMiddleCenter) (vla-put-InsertionPoint txt p) (ssdel e ss) )(princ "\0 Objects found:")) (command "_.undo" "_e") (princ))
Just be careful if you have some more complex shapes (typically "C" shape) -- label may be outside the closed area.
Report
0Likes
Reply
Message 3 of 14
Anonymous
in reply to:ВeekeeCZ
10-26-201603:30 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201603:30 AM
Yes,
This is what i wanted exactly, Thanks
Can you add Unit "m2" For me in this lisp?
Report
0Likes
Reply
Message 4 of 14
ВeekeeCZ
in reply to:Anonymous
10-26-201604:32 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201604:32 AM
@Anonymous wrote:Yes,
This is what i wanted exactly, Thanks
Can you add Unit "m2" For me in this lisp?
ok...
Spoiler
(defun c:PLArea (/ acsp ss e ptList ID StrField txt p) (vl-load-com) (command "_.undo" "_be") (setq acsp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (if (setq ss (ssget ;(progn;(initget 1 "Y N") ;(setq ans (getkword "\nProcess All Polylines [Yes/No]: "));(if (eq "Y" ans) ;"_X" ":L";)) '((0 . "*POLYLINE") ;(8 . "A-AREA-BDRY") (-4 . "&") (70 . 1)(410 . "Model")))) (repeat (sslength ss) (setq e (ssname ss 0) sum '(0 0) verts (cdr (assoc 90 (entget e)))) (setq ptList (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e)))) (foreach x ptList (setq sum (mapcar '+ x sum))) (setq ID (itoa (vla-get-objectid (vlax-ename->vla-object e)))) (setq StrField (strcat "%<\\AcObjProp Object(%<\\_ObjId " ID ">%).Area \\f \"%lu2\">%" "m2")) (vla-put-AttachmentPoint (setq txt (vla-addMText acsp (setq p (vlax-3d-point (mapcar '/ sum (list verts verts)))) 0 StrField)) acAttachmentPointMiddleCenter) (vla-put-InsertionPoint txt p) (ssdel e ss) )(princ "\0 Objects found:")) (command "_.undo" "_e") (princ))
Report
0Likes
Reply
Message 5 of 14
Anonymous
in reply to:ВeekeeCZ
10-26-201605:09 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201605:09 AM
It is not working on circles.
Report
0Likes
Reply
Message 6 of 14
Kent1Cooper
in reply to:Anonymous
10-26-201607:20 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201607:20 AM
@Anonymous wrote:It is not working on circles.
It's not written to do that. Curiously, your original code describes itself as only for Polylines, but in fact works on other entity types, too [even Lines! -- it puts 0.00 in for the area].
Here is one that reports in square meters. But it also says it's just for Polylines. Maybe you can easily take the part of it that determines the text content and transfer that into your code in Post 1 [and change the description in that, to not be in terms of only Polylines].
Kent Cooper, AIA 
Report
0Likes
Reply
Message 7 of 14
ВeekeeCZ
in reply to:Anonymous
10-26-201608:20 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201608:20 AM
@Anonymous wrote:It is not working on circles.
Spoiler
(vl-load-com)(defun c:PLArea (/ adoc acsp ss e ptList ID StrField txt p) (setq acsp (vla-get-modelspace (setq adoc (vla-get-activedocument (vlax-get-acad-object))))) (vla-startundomark adoc) (if (setq ss (ssget ;(progn;(initget 1 "Y N") ;(setq ans (getkword "\nProcess All Polylines [Yes/No]: "));(if (eq "Y" ans) ;"_X" ":L";)) '((-4 . "<OR") (0 . "CIRCLE") (-4 . "<AND") (0 . "*POLYLINE") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "OR>") ))) (repeat (sslength ss) (setq e (ssname ss 0) sum '(0 0) verts (cond ((cdr (assoc 90 (entget e)))) (1))) (setq ptList (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e)))) (foreach x ptList (setq sum (mapcar '+ x sum))) (setq ID (itoa (vla-get-objectid (vlax-ename->vla-object e)))) (setq StrField (strcat "%<\\AcObjProp Object(%<\\_ObjId " ID ">%).Area \\f \"%lu2\">%" "m2")) (vla-put-AttachmentPoint (setq txt (vla-addMText acsp (setq p (vlax-3d-point (mapcar '/ sum (list verts verts)))) 0 StrField)) acAttachmentPointMiddleCenter) (vla-put-InsertionPoint txt p) (ssdel e ss) ) (princ "\n0 Objects found:")) (vla-endundomark adoc) (princ))
Report
0Likes
Reply
Message 8 of 14
gpcattaneo
in reply to:ВeekeeCZ
10-26-201601:15 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201601:15 PM
@ВeekeeCZ wrote:Just be careful if you have some more complex shapes (typically "C" shape) -- label may be outside the closed area.
Try this...
A2.lsp
Report
3Likes
Reply
Message 9 of 14
ВeekeeCZ
in reply to:gpcattaneo
10-26-201602:00 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-26-201602:00 PM
@gpcattaneo, I mustadmitI'm impressed!! Nice solution!
-- haven't dig into algorithm much -- do you somehow test if a text is really inside?
I tried a little test... not really hard, these are the only shapes I've drawn...
Report
0Likes
Reply
Message 10 of 14
F.Camargo
in reply to:gpcattaneo
10-28-201603:48 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
10-28-201603:48 AM
@gpcattaneo wrote:@ВeekeeCZ wrote:Just be careful if you have some more complex shapes (typically "C" shape) -- label may be outside the closed area.
Try this...
Fantastic, Gian!!
It will be better if the texts were as a field.
Fabricio
Report
0Likes
Reply
Message 11 of 14
gpcattaneo
in reply to:ВeekeeCZ
11-01-201609:46 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
11-01-201609:46 AM
Thanks
@ВeekeeCZ
Increase the value of "step1"on very narrow polygons.
@F.Camargo
The field version...
A2.lsp
Report
1Like
Reply
Message 12 of 14
F.Camargo
in reply to:gpcattaneo
11-01-201602:04 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
11-01-201602:04 PM
Just amazing Gian!!
Thank you
Report
0Likes
Reply
Message 13 of 14
Anonymous
in reply to:Anonymous
07-31-201707:58 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-31-201707:58 AM
I tried this lisp it is very useful to me
but..why the result values are too big
how can I reduce the size of this lisp text
Report
0Likes
Reply
Message 14 of 14
gpcattaneo
in reply to:Anonymous
07-31-201708:38 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-31-201708:38 AM
Change the TEXTSIZE system variable.
Report
0Likes
Reply
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page
- Back to Topic Listing
- Previous
- Next
