Topic: show poly area dynamically

[MikeCreek]

Hi all
I am starting a land subdivision and wondered if it's possible to dynamically show the area of a closed polyline as I move one side of it? Is there a LISP routine available? Similar to how when a line is drawn, the length and angle are updated continuously.

Mike

[BIGAL]

There are a number of tools around for lot creation, bad news is they are generally part of a bigger add on so not free. Stuff like given area, parallel line, swing line and so on. They are out there do some searching.

[lamarn]

This is a good start
http://www.lee-mac.com/areastofield.html

[gile]

Hi,

If you're able to read or translate French, you can use or get inspiration from TotalArea.

Google translation of the TotalArea.txt contained in the ZIP:

TOTALAREA version 4.1.0 (gile)
Defines the AREABOX, TOTALAREA, AREAEDIT, AREASHOW and AREACONV commands

Block "Totalarea"

A block definition named "TotalArea" must be present in the drawing or as a "TotalArea.dwg" file in a directory of the search path.
This block must contain at least three attributes labeled "LABEL", "UNIT" and "AREA". The latter will be automatically filled in with the sum of the areas of the objects linked to it (arc, circle, ellipse, polyline, hatching, region, mpolygon).
If it contains another attribute labeled "NOBJ", it will also automatically be filled with the number of objects linked to the block.
The block can be dynamic.
An example block is attached in the ZIP file.


Format of the "AREA" attribute display

The number of decimal places displayed is managed by the AREAPREC variable


Conversion factor

It is possible to assign a conversion factor to the value of the attribute.
This value is managed with a variable (AREACONV) that can be modified with the command of the same name.


Updating the value of the attributes

The update of the "TotalArea" blocks is done automatically by modifying the objects linked to the block.
This update being linked to a reactor, the file must be loaded automatically at each startup.


AREABOX: Launch dialog box for orders.
TOTALAREA: Inserts the block "TotalArea" whose value of the attribute "AREA" is equal to the sum of the areas of the selected objects.
AREAEDIT: Binds or detaches the selected objects to the "TotalArea" block
AREASHOW: Highlights the objects linked to the block on which the cursor is moving

AREACONV: Change the value of the AREACONV variable.
This variable, registered in the registry, manages the conversion factor for units of length.
Example: 10000 for cm² -> m², 1000000 (or 1e6) for m² -> km²
AREAPREC: Change the value of the AREAPREC variable.
This variable, registered in the registry, manages the number of decimal places displayed.

[roy_043]

If I understand the OP's request correctly, he wants dynamic feedback while dragging a side of a polyline. I don't think this can be achieved with fields or reactors.

[VovKa]

Mike, the closest thing you can do is to use grread, but it's not very handy

Code: [Select]

(defun vk_PutCoordinate (p i c)
  (vlax-put-property
    p
    "Coordinate"
    i
    (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (length c))) c))
  )
)
(if (setq Polyline (entsel "\nLWPolyline: "))
  (progn (princ "OK\n")
(setq Point (reverse (cdr (reverse (cadr Polyline))))
       Polyline (vlax-ename->vla-object (car Polyline))
)
(setq Index  (fix (vlax-curve-getparamatpoint Polyline (vlax-curve-getclosestpointto Polyline Point)))
       Index  (list Index (rem (1+ Index) (fix (vlax-curve-getendparam Polyline))))
       Coord (mapcar (function
(lambda (i) (vlax-safearray->list (vlax-variant-value (vlax-get-property Polyline "Coordinate" i))))
      )
      Index
      )
)
(while (cond ((not (setq Input (grread t 12 0))))
      ((= (car Input) 5)
       (setq Vect (mapcar '- (cadr Input) Point))
       (mapcar (function (lambda (i c) (vk_PutCoordinate Polyline i (mapcar '+ Vect c)))) Index Coord)
       (princ (strcat "\r" (rtos (vlax-get-property Polyline "Area") 2) "   "))
      )
      ((= (car Input) 25)
       (mapcar (function (lambda (i c) (vk_PutCoordinate Polyline i c))) Index Coord)
       nil
      )
      ((= (car Input) 3) nil)
      (t)
)
)
  )
)


[MSTG007]

Just gonna ask. Are you guys using Civil3D? That has that built into it. Just a thought.

[Dlanor]

How about a dynamic block containing a polygon, with polar stretches on every vertex. A field would display the area. Once set explode it. 

[ribarm]

I had a spare time, so I rewrote VovKa's example... It's applicable only for single vertex/fit point... I don't know if it would be fine to implement LM's Grsnap (I don't think it would be much beneficial...)

Code: [Select]

(defun c:stretch-vertex-dyn-area&len ( / putcoordinate car-sort makenumblst c es p coords coord index input vect )

  (vl-load-com)

  (defun putcoordinate ( curve i c )
    (cond
      ( (vlax-property-available-p curve 'coordinates)
        (vla-put-coordinate curve i (vlax-3d-point c))
      )
      ( (vlax-property-available-p curve 'fitpoints)
        (vla-setfitpoint curve i (vlax-3d-point c))
      )
    )
  )

  (defun car-sort ( l f / removenth r k )

    (defun removenth ( l n / k )
      (setq k -1)
      (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l)
    )

    (setq k -1)
    (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l)
    r
  )

  (defun makenumblst ( n / k l )
    (setq k -1)
    (repeat n
      (setq l (cons (setq k (1+ k)) l))
    )
    (reverse l)
  )

  (while (or (not (setq c (car (setq es (entsel "\nPick curve near stretching vertex..."))))) (if c (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendpoint (list c)))))
    (prompt "\nMissed or picked wrong entity type...")
  )
  (setq p (vlax-curve-getclosestpointto c (cadr es)))
  (cond
    ( (vlax-property-available-p (vlax-ename->vla-object c) 'coordinates)
      (if (= (length (safearray-value (variant-value (vla-get-coordinate (vlax-ename->vla-object c) 0)))) 3)
        (setq coords (mapcar '(lambda ( i ) (safearray-value (variant-value (vla-get-coordinate (vlax-ename->vla-object c) i)))) (makenumblst (/ (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object c))))) 3))))
        (setq coords (mapcar '(lambda ( i ) (safearray-value (variant-value (vla-get-coordinate (vlax-ename->vla-object c) i)))) (makenumblst (/ (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object c))))) 2))))
      )
    )
    ( (vlax-property-available-p (vlax-ename->vla-object c) 'fitpoints)
      (setq coords (mapcar '(lambda ( i ) (safearray-value (variant-value (vla-getfitpoint (vlax-ename->vla-object c) i)))) (makenumblst (/ (length (safearray-value (variant-value (vla-get-fitpoints (vlax-ename->vla-object c))))) 3))))
    )
  )
  (setq coord (car-sort coords '(lambda ( a b ) (<= (distance p a) (distance p b)))))
  (if (and (equal coord (car coords) 1e-6) (equal coord (last coords) 1e-6))
    (setq index (list 0 (1- (length coords))))
    (setq index (list (vl-position coord coords)))
  )
  (while
    (cond
      ( (not (setq input (grread t 12 0))) )
      ( (= (car input) 5)
        (setq vect (mapcar '- (cadr input) (cadr es)))
        (mapcar '(lambda ( i ) (putcoordinate (vlax-ename->vla-object c) i (mapcar '+ vect coord))) index)
        (if (vlax-property-available-p (vlax-ename->vla-object c) 'Area)
          (princ (strcat "\nArea : " (rtos (vlax-get-property (vlax-ename->vla-object c) "Area") 2 50)))
        )
        (if (vlax-property-available-p (vlax-ename->vla-object c) 'Area)
          (princ (strcat "\tLength : " (rtos (vlax-curve-getdistatparam c (vlax-curve-getendparam c)) 2 50)))
          (princ (strcat "\nLength : " (rtos (vlax-curve-getdistatparam c (vlax-curve-getendparam c)) 2 50)))
        )
      )
      ( (= (car Input) 3) nil )
    )
  )
  (princ)
)

Regards, M.R.

[MikeCreek]

Thanks all, I'll let you know how I go.

cheers
Mike

[BIGAL]

Whilst lots have answered but not the poster, like the CIV3d advice enter the area required via the method and the solution is drawn automatically. Trying to drag a point will drive you nuts. There is a mathmatical solution for area for random points so you can reverse engineer the solution provide an area and picked point will move. I have been using this type of software solution for over 30 years. Yes its not free.

Anyway I have a swing line example posted at cadtutor. I realised there was a better mathmatical way so never finished it.

[MikeCreek]

This is a good start
http://www.lee-mac.com/areastofield.html

Thanks lamarn, very helpful.
cheers
Mike

[MikeCreek]

Whilst lots have answered but not the poster, like the CIV3d advice enter the area required via the method and the solution is drawn automatically. Trying to drag a point will drive you nuts. There is a mathmatical solution for area for random points so you can reverse engineer the solution provide an area and picked point will move. I have been using this type of software solution for over 30 years. Yes its not free.

Anyway I have a swing line example posted at cadtutor. I realised there was a better mathmatical way so never finished it.

Thanks BIGAL
cheers
Mike

[MikeCreek]

Thanks MR and VovKa
I've about to start using Bricscad so I'll definitely give it a go.

cheers

Mike

[BIGAL]

www.civilsitedesign.com.au is a full Civil package surveying, road design, drainage etc runs on Briscad and a reasonable price compared to CIV3D.

[xdcad]

Implemented using point monitor：

Code - Auto/Visual Lisp: [Select]

1. ;|
2. Dynamic mouse displays entity information
3. Switch command, on and off alternately
4. Command name: XDTB_EntityInfo
5.  
6. Switch (on,off) command, odd number on, even number off
7. |;
8. (defun c:XDTB_EntityInfo (/ ent lst1 lst2 #area #length)
9.   (defun Entity_Info (dynpt /)
10.     (setq ent (nentselp dynpt)
11.           ent (if (and
12.                     ent
13.                     (= (type (last (last ent))) 'ename)
14.                   )
15.                 (last (last ent))
16.                 (car ent)
17.               )
18.     )
19.     (if (and ent
20.              (xdrx-getpropertyvalue ent "area" "length")
21.         )
22.       (progn
23.         (setq str
24.                (xdrx-string-format
25.                  "\nObject   Area:%.2f\n\nObject Length:%.2f\n\n--------------------"
26.                  #area
27.                  #length
28.                )
29.         )
30.         str
31.       )
32.     )
33.   )
34.   (if *Entiy_Info*
35.     (progn
36.       (xdrx_PointMonitor)
37.       (princ "\nEntity data browsing is closed!")
38.       (setq *Entiy_Info* nil)
39.     )
40.     (progn
41.       (xdrx_PointMonitor "Entity_Info")
42.       (princ "\nEntity data browsing is open!")
43.       (setq *Entiy_Info* t)
44.     )
45.   )
46.   (princ)
47. )