Lisp lấy diện tích trong cad | How to get Area in AutoCAD | AutoLISP Reviewer

 Cách lấy diện tích đối tượng bao kín trong AutoCAD

 

Link tải miễn phí:

Tham gia nhóm Zalo AutoLISP trắc địa để Chia sẻ và Tải nhiều Autolisp về Trắc địa:

Link tham gia nhóm: http://tdz.lisp.vn

Hướng dẫn

• Bước 1: Tải tệp tin AutoLISP từ Mediafire
• Bước 2: Sử dụng APPLOAD (AP) để tải ứng dụng AutoLISP
• Bước 3: Sử dụng lệnh AA (Get Area) pick diện tích
• Bước 3a: Pick các tâm ô đất kín để tính diện tích
• Bước 3b: Chọn Text có sẵn để điền thông tin diện tích
• Bước 3c: Sử dụng Ctrl+V để paste diện tích sang một ứng dụng khác

 

Chi tiết 

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

  Tên ứng dụng:   Đo diện tích vùng kín - Lệnh AA (Get area)

 Tải về từ Mediafire ​

(hoặc copy nội dung sau)

Code:

;-------------------------------------------Do dien tich-----------------------------------
(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 (nentsel (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)
)

Giới thiệu phần mềm Quy hoạch LDT:

Cảm ơn các bạn đã theo dõi!