Re: Trapezoid area lisp

#16
SPirou4D wrote:
Fri Dec 23, 2022 4:53 am
BUT I can't remove to this problem :

Code: Select all

Run-time error 87:
error: too few arguments
nil
If someone can help me to correct this Please !
Hi,
Please replace the line:
(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "n" "n" "n")
by
(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "n" "n" )

and also IntelliCAD doesn't support some properties in the lines:

Code: Select all

(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 0 0)
					)

Re: Trapezoid area lisp

#17
Thanks you so QuanNguyen, you really follow me....
I tested your idea and now the popup to select new layer is deselected now! Thks

But I have yet one :
Run-time error 87:
error: too few arguments
nil

I changed this code:

Code: Select all

(mapcar
	'(lambda (pr val)
		(vlax-put-property nw_obj pr val)
	)
	(list 'AttachmentPoint 'Height 'Width 'color 'DrawingDirection 'EntityName 'EntityType 'StyleName 'Layer 'Linetype 'Lineweight 'Rotation 'BackgroundMask 'TrueColor 'Annotative)
	(list 1 (getvar "TEXTSIZE") "" 18 5 "Mtext" 23 (getvar "TEXTSTYLE") (getvar "CLAYER") (getvar "LINETYPE") (getvar "LINEWEIGHT") 0.0 "No" 18 "No")
)
with the list of all properties: (vlax-dump-object nw_obj )
but no changes.
Last edited by SPirou4D on Sat Dec 24, 2022 6:15 am, edited 2 times in total.
Patrick Depoix
Architecte D.P.L.G. & Historien-chercheur en histoire de l'Architecture

Re: Trapezoid area lisp

#18
BUT I can't remove this "too few arguments!" problem .

Certainly in this code :

Code: Select all

(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)
)
For me, Lisp is more complicated than perl or python....
Patrick Depoix
Architecte D.P.L.G. & Historien-chercheur en histoire de l'Architecture

Re: Trapezoid area lisp

#19
Yes, you need to check if the dxf_data existing the 90 and 63 dxf codes before trying to replace them.

I bypass some lines (set/change properties) and it works now.

Code: Select all

(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 diag1 diag2 diag max_diag pt4 surf1 surf2  nw_obj ent_text key)
	(command "_layer" "_m" "AREA CALC" "_c" "7" "" "")
	(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "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)
		)
	)
	(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)
								; triangles
								(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 3)) (atof (rtos d1 2 3)) 0.5)
										cum_area (atof (rtos (+ surf cum_area) 2 3))
									)
									(strcat
										"E" (itoa (setq count (1+ count))) " = "
										"1/2 x "
										(rtos max_d 2 2)
										" x (ht "
										(rtos d1 2 2)
										") = "
										(rtos surf 2 2) " m2\\P"
									)
								)
								; equilateral
								(if (and
									(equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)))
									(equal (distance (car ptlst) (caddr ptlst)) (distance (cadr ptlst) (cadddr ptlst))))
									(progn
										(setq
											d1 (atof (rtos (distance (car ptlst) (cadr ptlst)) 2 3))
											d2 (atof (rtos (distance (cadr ptlst) (caddr ptlst)) 2 3))
											surf (atof (rtos (* d1 d2) 2 3))
											cum_area (atof (rtos (+ surf cum_area) 2 3))
										)
										(strcat
											"E" (itoa (setq count (1+ count))) " = "
											(rtos d1 2 2)
											" x "
											(rtos d2 2 2)
											" = "
											(rtos surf 2 2)
											" m2\\P"
										)
									)
									; trapezoidals
									(progn
										(setq
											diag1 (distance (car ptlst) (caddr ptlst))
											diag2 (distance (cadr ptlst) (cadddr ptlst))
											diag (list diag1 diag2)
											max_diag (apply 'max diag)
											pt1 (if(> diag1 diag2) (car ptlst) (cadr ptlst))
											pt2 (if(> diag1 diag2) (caddr ptlst) (cadddr ptlst))
											pt3 (if(> diag1 diag2) (cadr ptlst) (caddr ptlst))
											pt4 (if(> diag1 diag2) (cadddr ptlst) (car ptlst))										
											d1  
											(distance
												pt3
												(inters
													pt1
													pt2
													pt3 
													(polar pt3 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
													nil
												)
											)
											d2  
											(distance
												pt4
												(inters
													pt1
													pt2
													pt4 
													(polar pt4 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
													nil
												)
											)
											ht 	(atof (rtos (+ d1 d2) 2 3))
											surf (* (atof(rtos max_diag 2 3)) (atof (rtos ht 2 3)) 0.5)
											cum_area (atof (rtos (+ surf cum_area) 2 3))
										)
										(strcat
											"E" (itoa (setq count (1+ count))) " = "
											"1/2 x "
											(rtos max_diag 2 2)
											" x (ht "
											(rtos ht 2 2)
											") = "
											(rtos surf 2 2) " m2\\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 "TOTAL = " (rtos cum_area 2 2) " m2")
						)
					)
				 
					;(setq entvla (vlax-ename->vla-object (car (entsel "\nChoix de l'entité\n"))))
					;(vlax-dump-object entvla)
					;(mapcar
					;	'(lambda (pr val)
					;		(vlax-put nw_obj pr val)
					;	)
					;	(list 'AttachmentPoint 'color 'DrawingDirection 'Height 'Layer 'Linetype 'LinetypeScale 'Lineweight 'StyleName 'Rotation 'Visible)
					;	(list 1 18 1 (getvar "TEXTSIZE") (getvar "CLAYER") (getvar "LINETYPE") 1 (getvar "LINEWEIGHT") (getvar "TEXTSTYLE") 0.0 -1)
					;)
				 	(mapcar
						'(lambda (pr val)
							(vlax-put nw_obj pr val)
						)
						(list 'AttachmentPoint  'Height 'StyleName 'Layer 'Rotation )
						(list 1  (getvar "TEXTSIZE") (getvar "TEXTSTYLE") (getvar "CLAYER") 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)(entupd ent_text)
							 
							)
						)
					)
					(setvar "TEXTSIZE" old_textsize)
				)
				(T (sssetfirst nil nil) (princ "\nFunction canceled because no calculation"))
			)
		)
		(T (princ "\nSelected items are invalid"))
	)
	(princ)
;return on the layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
(*error* "Modify your code !")
)

Re: Trapezoid area lisp

#20
Haaaaa YES that's work now: you can choose where you put the text! Very good QuanNguyen! Congratulation.

BUT I can't thank for his question the "ProM" who isn't a well brought up person!
Patrick Depoix
Architecte D.P.L.G. & Historien-chercheur en histoire de l'Architecture

Re: Trapezoid area lisp

#21
Here is the last release of this script with the choice of calculation of Trapezoids :

Code: Select all

(vl-load-com)
(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 diag1 diag2 diag max_diag pt4 surf1 surf2  nw_obj ent_text key)
	(command "_layer" "_m" "AREA CALC" "_c" "7" "" "")
	(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "N" "N")
	(while (null (setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . ">") (90 . 2) (-4 . "<") (90 . 5) (-4 . "AND>"))))))
	(setq trap (eq (getkword "\n Add trapezoids's calculations [Yes/No]? <Yes>: ") "No"))
	(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)
		)
		(initget "Yes No")
		(if (and trap (eq n 4))
			(if (not (and
					(equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)))
					(equal (distance (car ptlst) (caddr ptlst)) (distance (cadr ptlst) (cadddr ptlst))))
				)
				(ssdel ent js)
			)
		)
	)
	(cond
		((and js (> (sslength js) 0))
			(sssetfirst nil js)
			(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)
						; triangles
						(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 4)) (atof (rtos d1 2 4)) 0.5)
								cum_area (atof (rtos (+ surf cum_area) 2 4))
							)
							(strcat
								"E" (itoa (setq count (1+ count))) " = "
								"1/2 x "
								(rtos max_d 2 2)
								" x (ht "
								(rtos d1 2 2)
								") = "
								(rtos surf 2 2) " m2\\P"
							)
						)
						; equilateral
						(if (and
							(equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)))
							(equal (distance (car ptlst) (caddr ptlst)) (distance (cadr ptlst) (cadddr ptlst))))
							(progn
								(setq
									d1 (atof (rtos (distance (car ptlst) (cadr ptlst)) 2 4))
									d2 (atof (rtos (distance (cadr ptlst) (caddr ptlst)) 2 4))
									surf (atof (rtos (* d1 d2) 2 4))
									cum_area (atof (rtos (+ surf cum_area) 2 4))
								)
								(strcat
									"E" (itoa (setq count (1+ count))) " = "
									(rtos d1 2 2)
									" x "
									(rtos d2 2 2)
									" = "
									(rtos surf 2 2)
									" m2\\P"
								)
							)
							; trapezoidals
							(progn
								(setq
									diag1 (distance (car ptlst) (caddr ptlst))
									diag2 (distance (cadr ptlst) (cadddr ptlst))
									diag (list diag1 diag2)
									max_diag (apply 'max diag)
									pt1 (if(> diag1 diag2) (car ptlst) (cadr ptlst))
									pt2 (if(> diag1 diag2) (caddr ptlst) (cadddr ptlst))
									pt3 (if(> diag1 diag2) (cadr ptlst) (caddr ptlst))
									pt4 (if(> diag1 diag2) (cadddr ptlst) (car ptlst))
									d1  
									(distance
										pt3
										(inters
											pt1
											pt2
											pt3 
											(polar pt3 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
											nil
										)
									)
									d2  
									(distance
										pt4
										(inters
											pt1
											pt2
											pt4 
											(polar pt4 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
											nil
										)
									)
									ht 	(atof (rtos (+ d1 d2) 2 4))
									surf (* (atof(rtos max_diag 2 4)) (atof (rtos ht 2 4)) 0.5)
									cum_area (atof (rtos (+ surf cum_area) 2 4))
								)
								(strcat
									"E" (itoa (setq count (1+ count))) " = "
									"1/2 x "
									(rtos max_diag 2 2)
									" x (ht "
									(rtos ht 2 2)
									") = "
									(rtos surf 2 2) " m2\\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 "TOTAL = " (rtos cum_area 2 2) " m2")
				)
			)
			(mapcar
				'(lambda (pr val)
					(vlax-put nw_obj pr val)
				)
				(list 'AttachmentPoint  'Height 'StyleName 'Layer 'Rotation )
				(list 1  (getvar "TEXTSIZE") (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 )
			)
			(setq
				ent_text (entlast)
				dxf_ent (entget ent_text)
			) 
			(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)
						(entupd ent_text)
					)
				)
			)
			(setvar "TEXTSIZE" old_textsize)
		)
		(T (princ "\nSelected items are invalid"))
	)
	(princ)
;return on the layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
(*error* "")
)
EDIT 1 : Corrected with more precise rounded result !
image_2022-12-26_175020289.png
image_2022-12-26_175020289.png (34.85 KiB) Viewed 1881 times
Patrick Depoix
Architecte D.P.L.G. & Historien-chercheur en histoire de l'Architecture