Jump to content

Help with Area command ?


fathihvac

Recommended Posts

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

Link to comment
Share on other sites

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))))
      )

Link to comment
Share on other sites

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 .)

Link to comment
Share on other sites

Points?

Really? :huh: this would require MATH :shock:

 

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 by pBe
Add Code
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by fathihvac
Link to comment
Share on other sites

[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 :thumbsup:

 

Thanks Alanjt

 

Nowhere near as elegant as Alan's

-David

 

You're too modest David :)

Nice job

Link to comment
Share on other sites

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.

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 by pBe
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...