Jump to content

Lisp for getting area deducting cutout

Ankur

By Ankur
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Ankur Rookie

Ankur

Posted
Posted

Hi Everyone,

 

From few days I'm trying to make an auto lisp which can understand the difference between 2 different layers and calculate area according to that.

Unfortunately I'm not getting proper results anyone can please help.

 

I was trying to create the lisp in below steps.

Step-1: After entering command user will select whole drawing in single selection

Step-2: Lisp will select only object in Layer-1 & Layer-2 (Other layers objects will be ignored)

Step-3: Lisp will calculated the area of Layer-1 & Layer-2

Step-4: Now it will Subtract the area of Layer-2 from Layer-1

Step-5: and paste it as Text.

 

 

 

 

 

image.thumb.png.a5a5d0b2bb28812e8ca4300b3379cb5f.png

Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted (edited)

Is it just 1 closed polyline on Layer-1, and 1 on Layer -2?

Can there be overlap, or is 2 nicely within 1? (no overlap would make it easier)

 

Anyway, see if you're happy with this

  

(vl-load-com)

(defun drawM-Text (pt str)
 (entmakex (list (cons 0 "MTEXT")         
                 (cons 100 "AcDbEntity")
                 (cons 100 "AcDbMText")
                 (cons 10 pt)
                 (cons 1 str))))


;; ADC, for Area Deducting Cutout
(defun c:adc ( / ss l1 l2 i ent lay area1 area2 area3 txt txtobj)

;; Step-1: After entering command user will select whole drawing in single selection
  (princ "\nSelect all objects: ")
  (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE"))))
;; Step-2: Lisp will select only object in Layer-1 & Layer-2 (Other layers objects will be ignored)
  (setq i 0)
  (repeat (sslength ss)
    (setq ent (ssname ss i))
	;; read layer
	(setq lay (cdr (assoc 8 (entget ent))))
	(princ "\n")
	(princ lay)
;; Step-3: Lisp will calculated the area of Layer-1 & Layer-2
	(if (= "Layer-1" lay)
	  (progn
        (setq area1 (vla-get-area  (vlax-ename->vla-object ent)))
		(princ " - area: ")  
	    (princ area1)
	  )
	)
	(if (= "Layer-2" lay)
	  (progn
        (setq area2 (vla-get-area  (vlax-ename->vla-object ent)))
		(princ " - area: ")  
	    (princ area2)
	  )
	)
	
    (setq i (+ i 1))
  )
;; Step-4: Now it will Subtract the area of Layer-2 from Layer-1
  (setq area3 (- area1 area2))
;; Step-5: and paste it as Text.
  (setq txt
    (strcat
	  "Total Area: " (rtos area1 2 2)
	  "\nCutout Area: " (rtos area2 2 2)
	  "\nSubtracted Area: " (rtos area3 2 2)
	)
  )
  
  (drawM-Text (getpoint "\nPick a point to put the MText: ") txt)
  
  (princ)
)

 

Edited by Emmanuel Delay
forgot (vl-load-com)
  • Like 2
  • Thanks 1
ronjonp Grand Master

ronjonp

Posted
Posted

That hatch pattern in your screen shot should have the area you're looking for.

  • Like 2
Ankur Rookie

Ankur

Posted
  • Author
Posted
On 3/7/2022 at 6:04 PM, Emmanuel Delay said:

Is it just 1 closed polyline on Layer-1, and 1 on Layer -2?

Can there be overlap, or is 2 nicely within 1? (no overlap would make it easier)

 

Anyway, see if you're happy with this

  

(vl-load-com)

(defun drawM-Text (pt str)
 (entmakex (list (cons 0 "MTEXT")         
                 (cons 100 "AcDbEntity")
                 (cons 100 "AcDbMText")
                 (cons 10 pt)
                 (cons 1 str))))


;; ADC, for Area Deducting Cutout
(defun c:adc ( / ss l1 l2 i ent lay area1 area2 area3 txt txtobj)

;; Step-1: After entering command user will select whole drawing in single selection
  (princ "\nSelect all objects: ")
  (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE"))))
;; Step-2: Lisp will select only object in Layer-1 & Layer-2 (Other layers objects will be ignored)
  (setq i 0)
  (repeat (sslength ss)
    (setq ent (ssname ss i))
	;; read layer
	(setq lay (cdr (assoc 8 (entget ent))))
	(princ "\n")
	(princ lay)
;; Step-3: Lisp will calculated the area of Layer-1 & Layer-2
	(if (= "Layer-1" lay)
	  (progn
        (setq area1 (vla-get-area  (vlax-ename->vla-object ent)))
		(princ " - area: ")  
	    (princ area1)
	  )
	)
	(if (= "Layer-2" lay)
	  (progn
        (setq area2 (vla-get-area  (vlax-ename->vla-object ent)))
		(princ " - area: ")  
	    (princ area2)
	  )
	)
	
    (setq i (+ i 1))
  )
;; Step-4: Now it will Subtract the area of Layer-2 from Layer-1
  (setq area3 (- area1 area2))
;; Step-5: and paste it as Text.
  (setq txt
    (strcat
	  "Total Area: " (rtos area1 2 2)
	  "\nCutout Area: " (rtos area2 2 2)
	  "\nSubtracted Area: " (rtos area3 2 2)
	)
  )
  
  (drawM-Text (getpoint "\nPick a point to put the MText: ") txt)
  
  (princ)
)

 

Thank you so much for help its working but i was looking for

Multiple closed polyline on Layer-1, and 1 on Layer -2 it should consider and show result sum of all area after calculating.

And Layer-2 is for cutout so if there is no object in layer-2 it should consider 0 and calculate according to that.

Ankur Rookie

Ankur

Posted
  • Author
Posted
On 3/7/2022 at 9:08 PM, ronjonp said:

That hatch pattern in your screen shot should have the area you're looking for.

Thank you for your suggestion.

The screenshot was just for explaining purpose. Yes we can get area from the property of hatch.

But when we have multiple polyline so it will be tendentious todo hatch and add all the area. Thats why i want to create this lisp. 

ronjonp Grand Master

ronjonp

Posted
Posted (edited)

Untested ... 

(defun c:foo (/ a b c s)
  ;; RJP » 2022-03-14
  ;; Subtract one layer area from another
  (cond	((setq s (ssget '((0 . "LWPOLYLINE") (8 . " Layer-1,Layer-2"))))
	 (mapcar 'set '(a b) '(0 0))
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq c (vlax-curve-getarea e))
	   (if (wcmatch (cdr (assoc 8 (entget e))) "*1")
	     (setq a (+ a c))
	     (setq b (+ b c))
	   )
	 )
	 (alert (vl-princ-to-string (- a b)))
	)
  )
  (princ)
)

 

Edited by ronjonp
  • Like 1
BIGAL Grand Master

BIGAL

Posted
Posted

My $0.05

  

(vl-load-com)
(defun c:wowo ( / area1 area2 )
(setq area1 (vlax-get (vlax-ename->vla-object (car  (entsel "Pick obj"))) 'area))
(setq area2 (vlax-get (vlax-ename->vla-object (car  (entsel "Pick obj"))) 'area ))
(alert (strcat "Area is " (rtos (abs (- area1 area2)) 2 3)))
)
(c:wowo)

 

  • Like 1
ronjonp Grand Master

ronjonp

Posted
Posted
On 3/14/2022 at 10:11 PM, BIGAL said:

My $0.05

  

(vl-load-com)
(defun c:wowo ( / area1 area2 )
(setq area1 (vlax-get (vlax-ename->vla-object (car  (entsel "Pick obj"))) 'area))
(setq area2 (vlax-get (vlax-ename->vla-object (car  (entsel "Pick obj"))) 'area ))
(alert (strcat "Area is " (rtos (abs (- area1 area2)) 2 3)))
)
(c:wowo)

 

My $0.10 ... check your input. What if a block is picked? What if a pick is missed?

BIGAL Grand Master

BIGAL

Posted
Posted

ronjonp you are right it was done as a $0.05 answer the &0.20 answer would have the (if (and in it, use also say ssget pline so no wrong object selected.

Chetan Newbie

Chetan

Posted
Posted
On 3/7/2022 at 6:04 PM, Emmanuel Delay said:

Is it just 1 closed polyline on Layer-1, and 1 on Layer -2?

Can there be overlap, or is 2 nicely within 1? (no overlap would make it easier)

 

Anyway, see if you're happy with this

  

(vl-load-com)

(defun drawM-Text (pt str)
 (entmakex (list (cons 0 "MTEXT")         
                 (cons 100 "AcDbEntity")
                 (cons 100 "AcDbMText")
                 (cons 10 pt)
                 (cons 1 str))))


;; ADC, for Area Deducting Cutout
(defun c:adc ( / ss l1 l2 i ent lay area1 area2 area3 txt txtobj)

;; Step-1: After entering command user will select whole drawing in single selection
  (princ "\nSelect all objects: ")
  (setq ss (ssget (list (cons 0 "POLYLINE,LWPOLYLINE"))))
;; Step-2: Lisp will select only object in Layer-1 & Layer-2 (Other layers objects will be ignored)
  (setq i 0)
  (repeat (sslength ss)
    (setq ent (ssname ss i))
	;; read layer
	(setq lay (cdr (assoc 8 (entget ent))))
	(princ "\n")
	(princ lay)
;; Step-3: Lisp will calculated the area of Layer-1 & Layer-2
	(if (= "Layer-1" lay)
	  (progn
        (setq area1 (vla-get-area  (vlax-ename->vla-object ent)))
		(princ " - area: ")  
	    (princ area1)
	  )
	)
	(if (= "Layer-2" lay)
	  (progn
        (setq area2 (vla-get-area  (vlax-ename->vla-object ent)))
		(princ " - area: ")  
	    (princ area2)
	  )
	)
	
    (setq i (+ i 1))
  )
;; Step-4: Now it will Subtract the area of Layer-2 from Layer-1
  (setq area3 (- area1 area2))
;; Step-5: and paste it as Text.
  (setq txt
    (strcat
	  "Total Area: " (rtos area1 2 2)
	  "\nCutout Area: " (rtos area2 2 2)
	  "\nSubtracted Area: " (rtos area3 2 2)
	)
  )
  
  (drawM-Text (getpoint "\nPick a point to put the MText: ") txt)
  
  (princ)
)

 

Can please update with layer-2  4 or 5  different cutout area

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