Thứ Năm, 13 tháng 10, 2022

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

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

 


Link tải miễn phí:


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


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

Không có nhận xét nào:

Đăng nhận xét

Copy và Align trong AutoCAD | Free lisp Copy then Align in AutoCAD | AutoLISP Reviewer

 Lệnh Copy và Align trong cùng một lệnh CA Tải đoạn Lisp sau đây: