Lisp tính tổng diện tích | AutoLISP tính diện tích | Get Area in AutoCAD

 Lisp tính tổng diện tích

Link download: 

Chi tiết 

Sử dụng chức năng tải về hoặc lưu lại mã code dưới đây

* Lisp tính diện tích - Lệnh AA (Get Area)

 Tải về  ​

(hoặc copy nội dung sau)

Code:

;-------------------------------------------Get Area by AutoLISP Just Simple-----------------------------------
(defun C:AA (/ M ent ss area str C_text O_text N_text N_text1 Text olderr)
	(defun SetClipText (str / html result)
		(if (= 'STR (type str))
			(progn
				(setq html (vlax-create-object "htmlfile")
					result (vlax-invoke (vlax-get (vlax-get html 'ParentWindow) 'ClipBoardData) 'setData "Text" str))
				(vlax-release-object html)
			   str
			)
		)
	)
	
	(defun ssnewer (ent / ss ent1)
		(if ent
			(progn
				(setq ent1 ent)
				(while (setq ent1 (entnext ent1))
					(if ent1
						(progn
							(if (NULL ss) (setq ss (ssadd)))
							(setq ss (ssadd ent1 ss))
						)
					)
				)
				ss
			)
			nil
		)	
	)
	
	(defun sleep_osnap ()(setvar "OSMODE" (logior (getvar "OSMODE") 16384)))
	(defun wake_osnap ()(setvar "OSMODE" (logand (getvar "OSMODE") -16385)))
	(defun toggle_osnap ()(setvar "OSMODE" (boole 6 (getvar "OSMODE") 16384)))
	
	(setvar "CMDECHO" 0)
	(setvar "DIMZIN" 0)
	(setq ent_1_command (entlast))	
	(setq olderr *error*)
	(setq *error* 1error)
	
	(setq ent (entlast))
	(setq str "\nSpecify a point: ")
	(setq area 0.0)
	
	(sleep_osnap)
	
	(while (setq pt (getpoint str))
		(Command ".Bpoly" "a" "o" "r" "" pt "")
		(if (setq ss (ssnewer ent))
			(progn
				(Command "Union" ss "")
				(Command ".Area" "o" (entlast))
				(if area
					(setq area (abs (- (getvar "AREA") area)))
					(setq area (getvar "AREA"))
				)
				(princ (strcat "\nTotal: " (rtos (getvar "AREA") 2 (getvar "LUPREC")) "/  Area: " (rtos area 2 (getvar "LUPREC"))))					
			)			
		)
		(setq str "\nSpecify next point: ")
	)
	
	(wake_osnap)
	(setq C_text (strcat "" (rtos (getvar "AREA") 2 (getvar "LUPREC")) ""))	;Bien can thay vao text
	(setq *error* olderr)
	
	(if (setq ss (ssnewer ent)) (Command ".Erase" ss ""))
	
	(setcliptext C_text)
	(princ "Data was copied to the Clipboard")
	
	;Thay doi noi dung text
	(if (setq O-Text (entsel (strcat "\nSelect Area-Text object: ")))
		(progn
			
			(setq Text (car O-Text)
			N-Text (cons 1 C_text))
			(setq N-Text1 (subst N-Text (assoc 1 (entget Text)) (entget Text)))
			(entmod N-Text1)
			
		);Close Progn
	);Close IF
		
	(princ)
)

(hoặc copy nội dung sau)

How to get Area in AutoCAD?!

A Free autolisp routine from AutoLISP just simple

First, using command Appload to load the lisp file.

You can add it into the contents suite by drag and drop

Using command AA to invoke the application.

Using picking to specify area of the objects.

Then select the output text.

You can change the numbers of decimal place by using Units command.

Also, the result always be copied to the Clipboard. Using Ctrl+V to paste the result.

Download Link in the commments.

Thank you for watching!