Lisp for getting area deducting cutout

[Ankur]

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.

 

 

 

 

 

[Emmanuel Delay]

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 March 7, 2022 by Emmanuel Delay
forgot (vl-load-com)

[ronjonp]

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

[Ankur]

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]

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]

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 March 14, 2022 by ronjonp

[BIGAL]

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)

 

[ronjonp]

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]

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]

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