Identify areas larger than 300m2

December 12, 2022

Greetings, a query, I have several polygons and I would like to know which of them are larger than 300m2, for example, that they be marked with a color to identify them, could that be done?

Thank you.

polygons.dwg

December 12, 2022

Give this a try:

(defun c:foo (/ c n s)
  (cond	((and (or (setq n (getdist "\nEnter area value to check:<300> ")) (setq n 300))
	      (setq c (acad_truecolordlg 1))
	      (setq s (ssget '((0 . "LWPOLYLINE") (8 . "living"))))
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (if (>= (vlax-curve-getarea e) n)
	     (entmod (append (entget e) c))
	     (ssdel e s)
	   )
	 )
	 (sssetfirst nil s)
	)
  )
  (princ)
)

Edited December 12, 2022 by ronjonp
*added a selection set to the poly's found

December 12, 2022

Thank you, teacher

December 12, 2022

Another way. Makes a copy of the polyline and moves it to layer "match"

(defun C:PolyArea (/ n SS ent poly)
  (or (setq n (getdist "\nArea <300>: ")) (setq n 300))
  (if (setq SS (ssget "_X" '((0 . "*POLYLINE") (8 . "LIVING") (410 . "Model"))))
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (if (>= (vlax-curve-getarea e) n)
        (progn)
        (ssdel ent SS)
      )
    )
  )
  (if (> (setq i (sslength ss)) 0)
    (progn
      (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "Match") (70 . 0) (62 . 1)))
      (prompt (strcat "\n" (rtos i 2 0) " Polylines Found"))
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
        (setq poly (vlax-ename->vla-object ent))
        (setq copy (vla-copy poly))
        (vla-put-Layer copy "Match")
      )
    )
  )
  (princ)
)

Edited December 12, 2022 by mhupp
Updated Code - ronjonP

December 12, 2022

1 hour ago, cyberactive said:

Thank you, teacher

Glad to help!

December 12, 2022

3 hours ago, mhupp said:

Another way. Makes a copy of the polyline and moves it to layer "match"

(defun C:PolyArea (/ SS ent poly)
  (if (setq SS (ssget "_X" '((0 . "*POLYLINE") (8 . "LIVING") (410 . "Model"))))
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (if (>= (vlax-get (vlax-ename->vla-object ent) 'Area) 300)   ;(>= (vlax-curve-getarea e) 300.) is better
        (progn)
        (ssdel ent SS)
      )
    )
  )
  (if (> (setq i (sslength ss)) 0)
    (progn
      (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "Match") (70 . 0) (62 . 1)))
      (prompt (strcat "\n" (rtos i 2 0) " Polylines Found"))
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
        (setq poly (vlax-ename->vla-object ent))
        (setq copy (vla-copy poly))
        (vla-put-Layer copy "Match")
      )
    )
  )
  (princ)
)

Thank you very much, but you could have the option to enter the area. Greetings.

December 12, 2022

Try this change adding new line asking for area value and changing line 4 in full code.

(defun C:PolyArea (/ SS ent poly minarea)
 (setq minarea (getreal "\nEnter area to check for "))
  (if (setq SS (ssget "_X" '((0 . "*POLYLINE") (8 . "LIVING") (410 . "Model"))))
     (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (if (>= (vlax-get (vlax-ename->vla-object ent) 'Area) minarea)   ;(>= (vlax-curve-getarea e) 300.) is better
.............

December 12, 2022

1 hour ago, cyberactive said:

Thank you very much, but you could have the option to enter the area. Greetings.

Edited December 12, 2022 by ronjonp

December 12, 2022

just fyi Ron your code ask for an area but then only uses 300 to check instead of n.

(if (>= (vlax-curve-getarea e) 300.)

Edited December 12, 2022 by mhupp

December 12, 2022

1 minute ago, mhupp said:
just fyi Ron your code ask for an area but then only uses 300 to check instead of n.
(if (>= (vlax-curve-getarea e) 300.)

Ooops .. fixed above

December 17, 2022

On 12/13/2022 at 12:27 AM, ronjonp said:

Give this a try:

(defun c:foo (/ c n s)
  (cond	((and (or (setq n (getdist "\nEnter area value to check:<300> ")) (setq n 300))
	      (setq c (acad_truecolordlg 1))
	      (setq s (ssget '((0 . "LWPOLYLINE") (8 . "living"))))
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (if (>= (vlax-curve-getarea e) n)
	     (entmod (append (entget e) c))
	     (ssdel e s)
	   )
	 )
	 (sssetfirst nil s)
	)
  )
  (princ)
)

In the same problem, is it possible to find the area in the interval?

December 17, 2022

8 hours ago, mdchuyen said:

In the same problem, is it possible to find the area in the interval?

Please clear what you mean by "area in the interval" ??

December 17, 2022

maybe ?

300-400 area turn red

400-600 area turn blue

600+

would be a simple to change the if statement to cond

December 17, 2022

@mdchuyen Give this a try .. it checks for areas within a given range.

(defun c:foo (/ c mn mx s)
  (cond	((and (or (setq mn (getdist "\nEnter minimum area value to check:<0> ")) (setq mn 0))
	      (or (setq mx (getdist "\nEnter maximum area value to check:<500> ")) (setq mx 500))
	      (setq c (acad_truecolordlg 1))
	      (setq s (ssget '((0 . "LWPOLYLINE"))))
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (if (<= mn (vlax-curve-getarea e) mx)
	     (entmod (append (entget e) c))
	     (ssdel e s)
	   )
	 )
	 (sssetfirst nil s)
	)
  )
  (princ)
)

Edited December 17, 2022 by ronjonp

December 19, 2022

On 12/18/2022 at 3:07 AM, ronjonp said:

@mdchuyen Give this a try .. it checks for areas within a given range.

(defun c:foo (/ c mn mx s)
  (cond	((and (or (setq mn (getdist "\nEnter minimum area value to check:<0> ")) (setq mn 0))
	      (or (setq mx (getdist "\nEnter maximum area value to check:<500> ")) (setq mx 500))
	      (setq c (acad_truecolordlg 1))
	      (setq s (ssget '((0 . "LWPOLYLINE"))))
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (if (<= mn (vlax-curve-getarea e) mx)
	     (entmod (append (entget e) c))
	     (ssdel e s)
	   )
	 )
	 (sssetfirst nil s)
	)
  )
  (princ)
)

so wonderful. Thank you

December 19, 2022

1 hour ago, mdchuyen said:

so wonderful. Thank you

Glad to help

December 19, 2022

Very interesting, but it could be copied from the LIVING layer by LIVING-AREA with a different color, calculating the area in the center of the polygon or an area chart, for me it would be enough to pass it to another layer and color and then I calculate the areas, I hope it can, thank you very much, greetings.

December 19, 2022

2 hours ago, cyberactive said:

Very interesting, but it could be copied from the LIVING layer by LIVING-AREA with a different color, calculating the area in the center of the polygon or an area chart, for me it would be enough to pass it to another layer and color and then I calculate the areas, I hope it can, thank you very much, greetings.

Give this a try:

(defun c:foo (/ a i ll n s ur)
  (cond	((and (or (setq n (getdist "\nEnter area value to check:<300> ")) (setq n 300))
	      ;; (setq c (acad_truecolordlg 1))
	      (setq s (ssget '((0 . "LWPOLYLINE") (8 . "living"))))
	      (setq i 0)
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (if (>= (setq a (vlax-curve-getarea e)) n)
	     (progn (entmake (append (entget e) '((8 . "LIVING-AREA") (62 . 1))))
		    (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
		    (setq ll (vlax-safearray->list ll))
		    (setq ur (vlax-safearray->list ur))
		    (setq ll (mapcar '/ (mapcar '+ ll ur) '(2 2 2)))
		    (setq i (+ i a))
		    (entmake (list '(0 . "TEXT")
				   '(100 . "AcDbEntity")
				   '(67 . 0)
				   '(8 . "LIVING-AREA")
				   '(62 . 1)
				   '(100 . "AcDbText")
				   (cons 10 ll)
				   '(40 . 1.5)
				   (cons 1 (vl-princ-to-string a))
				   '(50 . 0.0)
				   '(41 . 1.0)
				   '(51 . 0.0)
				   '(71 . 0)
				   '(72 . 1)
				   (cons 11 ll)
				   '(100 . "AcDbText")
				   '(73 . 2)
			     )
		    )
	     )
	     ;; (ssdel e s)
	   )
	 )
	 ;; Print total to command line
	 (print i)
	 ;; (sssetfirst nil s)
	)
  )
  (princ)
)

Edited December 19, 2022 by ronjonp

December 19, 2022

5 hours ago, ronjonp said:

Give this a try:

(defun c:foo (/ a i ll n s ur)
  (cond	((and (or (setq n (getdist "\nEnter area value to check:<300> ")) (setq n 300))
	      ;; (setq c (acad_truecolordlg 1))
	      (setq s (ssget '((0 . "LWPOLYLINE") (8 . "living"))))
	      (setq i 0)
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (if (>= (setq a (vlax-curve-getarea e)) n)
	     (progn (entmake (append (entget e) '((8 . "LIVING-AREA") (62 . 1))))
		    (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
		    (setq ll (vlax-safearray->list ll))
		    (setq ur (vlax-safearray->list ur))
		    (setq ll (mapcar '/ (mapcar '+ ll ur) '(2 2 2)))
		    (setq i (+ i a))
		    (entmake (list '(0 . "TEXT")
				   '(100 . "AcDbEntity")
				   '(67 . 0)
				   '(8 . "LIVING-AREA")
				   '(62 . 1)
				   '(100 . "AcDbText")
				   (cons 10 ll)
				   '(40 . 1.5)
				   (cons 1 (vl-princ-to-string a))
				   '(50 . 0.0)
				   '(41 . 1.0)
				   '(51 . 0.0)
				   '(71 . 0)
				   '(72 . 1)
				   (cons 11 ll)
				   '(100 . "AcDbText")
				   '(73 . 2)
			     )
		    )
	     )
	     ;; (ssdel e s)
	   )
	 )
	 ;; Print total to command line
	 (print i)
	 ;; (sssetfirst nil s)
	)
  )
  (princ)
)

Thanks, I could know how many polygons were found, I've been trying to add it (prompt (strcat "\n" (rtos i 2 0) "Polylines found")), but I don't know where to place it to give me the result.

December 19, 2022

Make these changes:

Sign In

Identify areas larger than 300m2

Recommended Posts

cyberactive

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp

ronjonp

BIGAL

Posted Images

ronjonp

cyberactive

mhupp

ronjonp

cyberactive

BIGAL

ronjonp

mhupp

ronjonp

mdchuyen

devitg

mhupp

ronjonp

mdchuyen

ronjonp

cyberactive

ronjonp

cyberactive

ronjonp

Join the conversation

ronjonp

ronjonp

BIGAL

Tutorials

Forums

Activity