fathihvac Posted August 12, 2011 Share Posted August 12, 2011 Hello, Can anyone write an autolisp to use area command and insert the result as text string in the drawing area Quote Link to comment Share on other sites More sharing options...
MSasu Posted August 12, 2011 Share Posted August 12, 2011 This should get you started: (command "_AREA" pause) (setq MyArea (getvar "AREA")) Pay attention to RTOS function for string conversion in the required format. Regads, Mircea Quote Link to comment Share on other sites More sharing options...
pBe Posted August 12, 2011 Share Posted August 12, 2011 Easy really.. but Units? What's the source of the area info? an entity? ? from reading a external file? a value from Attribute Block? (defun c:GetArea (/ area sset) (vl-load-com) (ssget);<--- insert filter here (setq area 0) (vlax-for H (setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) (setq area (+ (vla-get-area h) area)) ) (vla-delete sset) (alert (strcat "\nTotal area = " (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4)) (strcat (rtos area 2) " sq. in. (" (rtos (/ area 144) 2) " sq. ft.)") (rtos area)))) ) Quote Link to comment Share on other sites More sharing options...
fathihvac Posted August 12, 2011 Author Share Posted August 12, 2011 Easy really.. but Units? What's the source of the area info? an entity? ? from reading a external file? a value from Attribute Block? (defun c:GetArea (/ area sset) (vl-load-com) (ssget);<--- insert filter here (setq area 0) (vlax-for H (setq sset (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) (setq area (+ (vla-get-area h) area)) ) (vla-delete sset) (alert (strcat "\nTotal area = " (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4)) (strcat (rtos area 2) " sq. in. (" (rtos (/ area 144) 2) " sq. ft.)") (rtos area)))) ) The source is points.The units meter square m² (m² strcat to area value text .) Quote Link to comment Share on other sites More sharing options...
pBe Posted August 12, 2011 Share Posted August 12, 2011 (edited) Points? Really? this would require MATH Post a sample drawing or an image so we can break it down. The easiest way to do that is to select the points in order (Clockwise or CClockwise), create a pline , get the area, delete the entity, but where's the fun in that? I'm pretty sure a similar program has been written a dozen times on this forum.. Try the search button, you might get lucky Heres a quick one: not fun at all.... (defun c:AreaFromPoints (/ PtList i area) (defun LWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst)))) (setq pts (ssget ":L" '((0 . "POINT")))) (repeat (setq i (sslength pts)) (setq PtList (cons (cdr (assoc 10 (entget (ssname pts (setq i (1- i)))))) PtList) ) ) (Lwpoly PtList 1) (setq area (vla-get-area (vlax-ename->vla-object (entlast)))) (entdel (entlast)) (princ (strcat "\nTotal area = " (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4)) (strcat (rtos area 2) " sq. in. (" (rtos (/ area 144) 2) " sq. ft.)") (rtos area))) ) (princ) ) Remember:Select the points in order It would be nice to write it with these conditions Selecting the points via window selection Sort the points (somehow) Derive the area form points only (no pline creation) Give Area/Perimeter Now that is fun to code Edited August 12, 2011 by pBe Add Code Quote Link to comment Share on other sites More sharing options...
pBe Posted August 12, 2011 Share Posted August 12, 2011 Reading the post again i think i went bit overboard on this one Quote Link to comment Share on other sites More sharing options...
alanjt Posted August 12, 2011 Share Posted August 12, 2011 ..................AreaFromPoints.LSP Quote Link to comment Share on other sites More sharing options...
David Bethel Posted August 12, 2011 Share Posted August 12, 2011 Nowhere near as elegant as Alan's But it should work: ;======================================================================= ; DYN-Area.Lsp Aug 12, 2011 ; Dynamic Area Calulations ;================== Start Program ====================================== (princ "\nCopyright (C) 1990-2011, Fabricated Designs, Inc.") (princ "\nLoading DYN-Area v1.0 ") (setq dya_ nil lsp_file "DYN-Area") ;++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++ (defun dya_smd () (SetUndo) (setq olderr *error* *error* (lambda (msg) (while (> (getvar "CMDACTIVE") 0) (command)) (and (/= msg "quit / exit abort") (princ (strcat "\nError: *** " msg " *** "))) (and (= (logand (getvar "UNDOCTL") 8) (command "_.UNDO" "_END" "_.U")) (dya_rmd)) dya_var '(("CMDECHO" . 0) ("COORDS" . 2) ("OSMODE" . 0) ("SORTENTS" . 119) ("BLIPMODE" . 0) ("ORTHOMODE" . 0) ("SNAPMODE" . 0) ("PLINEWID" . 0) ("ELEVATION" . 0) ("THICKNESS" . 0) ("CECOLOR" . "BYLAYER") ("CELTYPE" . "BYLAYER"))) (foreach v dya_var (and (getvar (car v)) (setq dya_rst (cons (cons (car v) (getvar (car v))) dya_rst)) (setvar (car v) (cdr v)))) (princ)) ;++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++ (defun dya_rmd () (setq *error* olderr) (foreach v dya_rst (setvar (car v) (cdr v))) (command "_.UNDO" "_END") (prin1)) ;++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++ (defun SetUndo () (and (zerop (getvar "UNDOCTL")) (command "_.UNDO" "_ALL")) (and (= (logand (getvar "UNDOCTL") 2) 2) (command "_.UNDO" "_CONTROL" "_ALL")) (and (= (logand (getvar "UNDOCTL") 8) (command "_.UNDO" "_END")) (command "_.UNDO" "_GROUP")) ;************ Main Program *************************************** (defun dya_ (/ olderr dya_var dya_rst sp pl np tl) (dya_smd) (initget 1) (setq sp (getpoint "\n1st Point: ")) (setq pl (list sp)) (while (setq np (getpoint sp "\nNext Point - (Enter to Exit): ")) (setq pl (cons np pl) tl pl sp np) (command "_.PLINE") (foreach p pl (command p)) (command "_CL") (command "_.AREA" "_E" (entlast)) (command "_.ERASE" (entlast) "") (princ (strcat " = " (rtos (getvar "AREA")))) (redraw) (repeat (1- (length tl)) (grdraw (nth 0 tl) (nth 1 tl) 2 1) (setq tl (cdr tl))) (grdraw (nth 0 tl) np 2 1)) (redraw) (repeat (1- (length pl)) (grdraw (nth 0 pl) (nth 1 pl) 7 1) (setq pl (cdr pl))) (grdraw (nth 0 pl) sp 7 1) (princ (strcat " = " (rtos (getvar "AREA")))) (dya_rmd)) ;************ Load Program *************************************** (defun C:DYN-Area () (dya_)) (if dya_ (princ "\nDYN-Area Loaded\n")) (prin1) ;|================== End Program ======================================= -David Quote Link to comment Share on other sites More sharing options...
fathihvac Posted August 12, 2011 Author Share Posted August 12, 2011 (edited) Thanks for all My goal is to use autocad command _measuregeom (and precisely area) but i want to insert the result of this autocad command as text in the drawing area.Example : I have plan for offices restaurant and rooms. I want to calculate and put areas values for each of previous mentioned for later cooling load calcs.(Hvac) I hope you have understood what i want. May Be something like attached get area.lsp Edited August 12, 2011 by fathihvac Quote Link to comment Share on other sites More sharing options...
pBe Posted August 13, 2011 Share Posted August 13, 2011 [ATTACH]29328[/ATTACH].................. (mapcar '(lambda (a b) (grdraw a b 7)) (setq lst (if (eq pt "Undo") (cdr lst) (cons pt lst) ) ) (cons (last lst) lst) ) Nicel Thanks Alanjt Nowhere near as elegant as Alan's-David You're too modest David Nice job Quote Link to comment Share on other sites More sharing options...
pBe Posted August 13, 2011 Share Posted August 13, 2011 (edited) Thanks for allMy goal is to use autocad command _measuregeom (and precisely area) but i want to insert the result of this autocad command as text in the drawing area.Example : I have plan for offices restaurant and rooms. May Be something like attached So you meant points on screen and not the entity point in that case, something as simple as this would work (defun c:test (/ pt1 pt2 pt3 LxW str) (setq pt1 (getpoint "\nLower Left Corner:") pt3 (getcorner pt1 "\nLower Upper Rigbt Corner:")) (setq pt2 (list (car pt1) (cadr pt3) 0.0)) (setq LxW (list (distance pt1 pt2) (distance pt2 pt3))) (setq str (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4)) (strcat (rtos (/ (apply '* Lxw) 144) 2) " sq. ft.") (strcat (rtos (apply '* Lxw)) " m²") ) ) (command "_text" "_Justify" "_center" "_non" (mapcar (function (lambda (a b) (/ (+ a b) 2.))) pt1 pt3) (getvar 'TextSize) 0 str) ) I wanted to try the _measuregeom approach, unfortunately i dont have any idea what it does. you can use something like this right after the "_measuregeom" (defun c:test (/ str pt) (setq str (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4)) (strcat (rtos (/ (getvar "AREA") 144) 2) " sq. ft.") (strcat (getvar "AREA") " m²") ) ) (setq pt (getpoint "\n Select insertion point : ")) (command "_text" "_Justify" "_center" "_non" pt (getvar 'TextSize) 0 str) ) Reminder: (command "_text" "_Justify" "_center" "_non" pt (getvar 'TextSize) 0 str) if your current text style height is non zero, the line above will skip the text height prompt and take (getvar 'TextSize) as rotation and 0 as STR. This Edited August 13, 2011 by pBe Quote Link to comment Share on other sites More sharing options...
pBe Posted August 13, 2011 Share Posted August 13, 2011 Points? It would be nice to write it with these conditions Selecting the points via window selection Sort the points (somehow) Derive the area form points only (no pline creation) Give Area/Perimeter Now that is fun to code Here's a quick one (defun c:FunForMe (/ Pts plst x1 x2 x3 x4 Pt2Pt Perim area str) (cond ((and (setq pts (ssget ":L" '((0 . "POINT")))) (progn (repeat (setq i (sslength pts)) (setq plst (cons (cdr (assoc 10 (entget (ssname pts (setq i (1- i)))))) plst) ) ) (setq plst (append plst (list (last (reverse plst))))) (repeat (sslength pts) (setq x1 (car (car plst)) x2 (cadr (car plst)) y1 (car (cadr plst)) y2 (cadr (cadr plst)) ) (setq Pt2Pt (cons (- (* x1 y2) (* x2 y1)) Pt2Pt)) (setq PeriM (cons (distance (car plst)(cadr plst)) PeriM)) (setq plst (cdr plst)) ) (setq Area (abs (/ (apply '+ Pt2pt) 2))) ) (setq str (if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4)) (strcat (rtos (/ area 144) 2) " sq. ft.") (strcat (rtos Area 2) " m²") ) ) (print Str) (princ (strcat "\nPerimeter: \"" (rtos (apply '+ Perim) 2 2) "\"")) ) ) )(princ) ) The thing i need to figure out now is sorting the PontList when using window selection. 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.