Lệnh AA

Pick diện tích bằng cách pick vào tâm vùng kín để lấy diện tích.

Enter để kết thúc việc pick và ghi diện tích

Dùng lệnh TextSize để thay đổi chiều cao chữ

Dùng lệnh LUPREC hoặc lệnh UNITS để thay đổi số chữ số thập phân

1 Thêm class AA.lsp

Lưu mã sau dưới dạng tệp tin AJS_.lsp

Code:

;-------------------------------------------Do dien tich-----------------------------------
(defun C:AA (/ M ent ss area str C_text O_text N_text N_text1 Text olderr)
	(princ "Chương trình tính và Ghi diện tích - lisp.vn HN t3/2026")
	(princ "\nDùng lệnh TextSize để thay đổi chiều cao chữ")
	(princ "\nDùng lệnh LUPREC để thay đổi số chữ số thập phân")
	
	(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 LM:ssboundingbox ( s / a b i m n o )
		(repeat (setq i (sslength s))
			(if
				(and
					(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
					(vlax-method-applicable-p o 'getboundingbox)
					(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
				)
				(setq m (cons (vlax-safearray->list a) m)
					  n (cons (vlax-safearray->list b) n)
				)
			)
		)
		(if (and m n)
			(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
		)
	)
	
	(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
	(setcliptext C_text)
	(princ "Data was copied to the Clipboard")
	
	(setq *error* olderr)
	(setq ss (ssnewer ent))
	(setq maxmin (LM:ssboundingbox ss))
	
	(if ss
		(progn
			(Command ".Erase" ss "")
			(setq pt (list (* 0.5 (+ (car (car maxmin)) (car (cadr maxmin)))) (* 0.5 (+ (cadr (car maxmin)) (cadr (cadr maxmin))))))
			(if pt
				(progn
				  ; Tạo text mới với justification = Middle Center
				  (entmake
					(list
					  '(0 . "TEXT")
					  '(100 . "AcDbEntity")
					  '(100 . "AcDbText")
					  (cons 10 pt)             ; insertion point
					  (cons 40 (getvar "TEXTSIZE"))            ; text height
					  (cons 1 C_text)          ; nội dung text
					  (cons 7 "Standard")      ; text style (có thể đổi)
					  '(71 . 0)                ; text generation flags
					  '(72 . 1)                ; horizontal justification = Center
					  '(73 . 2)                ; vertical justification   = Middle
					  (cons 11 pt)    ; alignment point (dùng khi justify không phải left)
					)
				  )
				  (princ "\nĐã tạo text mới xong.")
				)
				(princ "\nĐã hủy lệnh (không pick được điểm).")
			)
		)
	)
	(princ "\nby lisp.vn\n")
	(princ)
)