Help with area calculation lisp

[topomav]

Hi, I am using this lisp for analytic calculation. Is it possible to update the code to support trapezoid area ?

(defun c:areacal ( / js nb ent dxf_ent ptlst surf n AcDoc Space old_textsize count app_txt cum_area pt_ins val_txt lst_bis l_4d max_d pos pt1 pt2 pt3 d1 d2 nw_obj ent_text key)
       (command "_layer" "_m" "AREA CALC" "_c" "7" "" "")
       (command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "n" "n" "n")
	(while (null (setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . ">") (90 . 2) (-4 . "<") (90 . 5) (-4 . "AND>"))))))
	(repeat (setq nb (sslength js))
		(setq
			ent (ssname js (setq nb (1- nb)))
			dxf_ent (entget ent)
			ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
			n (length ptlst)
		)
		(if (eq n 4)
			(if (not (and (equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)) 1E-08)))
				(ssdel ent js)
			)
		)
	)
	(cond
		((and js (> (sslength js) 0))
			(sssetfirst nil js)
			(initget "Yes No")
			(cond
				((not (eq (getkword "\n Insert calculations [Yes/No]? <Yes>: ") "No"))
					(sssetfirst nil nil)
					(setq
						AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
						Space
						(if (= 1 (getvar "CVPORT"))
							(vla-get-PaperSpace AcDoc)
							(vla-get-ModelSpace AcDoc)
						)
						old_textsize (getvar "TEXTSIZE")
						count 0
						app_txt ""
						cum_area 0.0
					)
					(setvar "TEXTSIZE" 2.5)
					(repeat (setq nb (sslength js))
						(setq
							ent (ssname js (setq nb (1- nb)))
							dxf_ent (entget ent)
							ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
							n (length ptlst)
							pt_ins (list (/ (apply '+ (mapcar 'car ptlst)) n) (/ (apply '+ (mapcar 'cadr ptlst)) n))
							val_txt
							(if (eq n 3)
								(progn
									(setq
										lst_bis (append (cdr ptlst) (list (car ptlst)))
										l_4d (mapcar 'distance ptlst lst_bis)
										max_d (apply 'max l_4d)
										pos (vl-position max_d l_4d)
										pt1 (nth pos ptlst)
										pt2 (nth pos lst_bis)
										pt3 (car (vl-remove pt2 (vl-remove pt1 ptlst)))
										d1
										(distance
											pt3
											(inters
												pt1
												pt2
												pt3
												(polar pt3 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
												nil
											)
										)
										surf (* (atof(rtos max_d 2 2)) (atof (rtos d1 2 2)) 0.5)
										cum_area (atof (rtos (+ surf cum_area) 2 2))
									)
									(strcat
										"Ε" (itoa (setq count (1+ count))) " = "
										"1/2 x "
										(rtos max_d 2 2)
										" x "
										(rtos d1 2 2)
										" = "
										(rtos surf 2 2) " sq.m\\P"
									)
								)
								(progn
									(setq
										d1 (atof (rtos (distance (car ptlst) (cadr ptlst)) 2 2))
										d2 (atof (rtos (distance (cadr ptlst) (caddr ptlst)) 2 2))
										surf (atof (rtos (* d1 d2) 2 2))
										cum_area (atof (rtos (+ surf cum_area) 2 2))
									)
									(strcat
										"Ε" (itoa (setq count (1+ count))) " = "
										(rtos d1 2 2)
										" x "
										(rtos d2 2 2)
										" = "
										(rtos surf 2 2)
										" sq.m\\P"
									)
								)
							)
							app_txt (strcat app_txt val_txt)
						)
						(entmake
							(list
								'(0 . "TEXT")
								'(100 . "AcDbEntity")
								(cons 8 (getvar "CLAYER"))
								'(100 . "AcDbText")
								(cons 10 pt_ins)
								(cons 40 (getvar "TEXTSIZE"))
								(cons 1 (strcat "E" (itoa count)))
								(cons 50 (angle '(0 0 0) (getvar "UCSXDIR")))
								'(41 . 1.0)
								'(51 . 0.0)
								(cons 7 (getvar "TEXTSTYLE"))
								'(71 . 0)
								'(72 . 1)
								(cons 11 pt_ins)
								(assoc 210 dxf_ent)
								'(100 . "AcDbText")
								'(73 . 2)
							)
						)
					)
					(setq nw_obj
						(vla-addMtext Space
							(vlax-3d-point (trans (getvar "VIEWCTR") 1 0))
							0.0
							(strcat app_txt "Εολ = " (rtos cum_area 2 2) " sq.m")
						)
					)
					(mapcar
						'(lambda (pr val)
							(vlax-put nw_obj pr val)
						)
						(list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color)
						;(list 1 (getvar "TEXTSIZE") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 250)
						(list 1 (getvar "TEXTSIZE") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 0 0)
					)
					(setq
						ent_text (entlast)
						dxf_ent (entget ent_text)
						dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent)
						dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent)
					)
					(entmod dxf_ent)
					(while (and (setq key (grread T 4 0)) (/= (car key) 3))
						(cond
							((eq (car key) 5)
								(setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent))
								(entmod dxf_ent)
							)
						)
					)
					(setvar "TEXTSIZE" old_textsize)
				)
				(T (sssetfirst nil nil) (princ "\nFunction canceled"))
			)
		)
		(T (princ "\nSelected items are invalid"))
	)
	(princ)
;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
(*error* "")
)

Thanks

[topomav]

Any ideas?
Thanks

[peter]

Can you explain what verbally what this program is doing?

Can you show a test drawing?

You are creating a sset of lwpolylines I get that...



P=

[topomav]

Insert a text with analytic calculation area of rectangles and triangles. I want to support and trapezoid area.

[Bruno.Valsecchi]

Maybe by commenting or deleting this part...?

		(if (eq n 4)
			(if (not (and (equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)) 1E-08)))
				(ssdel ent js)
			)
		)

[topomav]

Hi Bruno.Valsecchi. I want to add a calculation for trapezoid areas. E = 1/2 x (a+b) x h

[Opie]

Have you looked at the Area property of a lightweight polyline object? You are already using some VLA objects and methods. This may simplify some of your code.

Another suggestion is to break your code into smaller subroutines that do one thing and then combine the results from these smaller subroutines into your monolith routine. It would help in reusing code for other purposes also.

[topomav]

Hi Opie.I use this code to analytic calculate areas like the attach file. Most of the times i have trapezoid ares and this code not working.

[Opie]

Your routine places a text over the center of the area selected. It then places a string with the location label = the horizontal and vertical lengths = the area of the selected polyline. It then creates a total cumulative area at the bottom of the areas labels. The bounding box of the polyline object could be used for the lengths if they are drawn square. The area property of the polyline object could also be used.

In your sample drawing, you have (at least) two trapezoids at the bottom of the drawing. How would you want the output listed for a trapezoid?

[topomav]

like the the mathematic type. If i have a rectangle ,triangle ,and trapezoid

E = a x b + 1/2 x a x h + 1/2 x (a + b) x h = .... + ..... + .... = ...... sq.m