Jump to content

Identify areas larger than 300m2

cyberactive

By cyberactive
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

cyberactive Explorer

cyberactive

Posted
Posted

 

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

Link to comment
Share on other sites
  • Replies 20
  • Created
  • Last Reply

Top Posters In This Topic

  • ronjonp

    8

  • cyberactive

    6

  • mhupp

    3

  • mdchuyen

    2

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp
ronjonp

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 '((

ronjonp
ronjonp

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

BIGAL
BIGAL

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

Posted Images

ronjonp Grand Master

ronjonp

Posted
Posted (edited)

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 by ronjonp
*added a selection set to the poly's found
  • Like 4
Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted (edited)

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 by mhupp
Updated Code - ronjonP
Link to comment
Share on other sites
cyberactive Explorer

cyberactive

Posted
  • Author
Posted
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.

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

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

 

  • Like 1
Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

Posted
Posted (edited)
1 hour ago, cyberactive said:

 

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

image.png.0b1245e3b7314a2ec9fcac7ce62c6066.png

Edited by ronjonp
  • Like 1
Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted (edited)

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 by mhupp
  • Thanks 1
Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

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

Link to comment
Share on other sites
mdchuyen Explorer

mdchuyen

Posted
Posted
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?

Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

Posted
Posted (edited)

@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 by ronjonp
  • Like 2
Link to comment
Share on other sites
mdchuyen Explorer

mdchuyen

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

Link to comment
Share on other sites
cyberactive Explorer

cyberactive

Posted
  • Author
Posted

 

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.

Link to comment
Share on other sites
ronjonp Grand Master

ronjonp

Posted
Posted (edited)
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)
)

image.png.2e59f9959c6dda5ae1ab4f52620fc0c2.png

Edited by ronjonp
  • Like 1
Link to comment
Share on other sites
cyberactive Explorer

cyberactive

Posted
  • Author
Posted
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)
)

image.png.2e59f9959c6dda5ae1ab4f52620fc0c2.png

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.

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.

×
 Share
Go to topic listing
×
×
  • Create New...