Lisp miễn phí đo nhanh diện tích và chiều dài 11 22 | Ghi kết quả ra Text hoặc Attribute | AutoLISP Reviewer

Ứng dụng được phát triển/Sưu tầm bởi đội ngũ AutoLISP Thật là đơn giản

   

Thông tin thêm: 👉👉👉

Đo Diện tích 11 

Pick các điểm tâm các ranh kín

Đo Chiều dài 22

Pick các cặp điểm để tính tổng chiều dài

1 Thêm class [11] [22] Do dien tich chieu dai by AJS.lsp

Lưu mã sau dưới dạng tệp tin [11] [22] Do dien tich chieu dai by AJS.lsp

Code:

(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 C:11 (/ M ent ss area str C_text O_text N_text N_text1 Text olderr)
	(setvar "CMDECHO" 0)
	(setvar "DIMZIN" 0)
	(setq ent_1_command (entlast))	
	(setq olderr *error*)
	(setq *error* 1error)
	(setq oldosm (getvar "OSMODE"))
	(setq ent (entlast))
	(setq str "\nSpecify a point: ")
	(setq area 0.0)
	(if (< oldosm 15360) (setvar "OSMODE" (+ 16384 oldosm)))
	(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: ")
	)
	(setvar "OSMODE" oldosm)
	;Thay doi noi dung text
	(if (setq O-Text (nentsel (strcat "\nSelect Area-Text object: ")))
		(progn
			(setq C_text (strcat "" (rtos (getvar "AREA") 2 (getvar "LUPREC")) ""))	;Bien can thay vao text
			(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)
			(setcliptext C_text)
		);Close Progn
	);Close IF
	(if (setq ss (ssnewer ent)) (Command ".Erase" ss ""))
	(setq *error* olderr)
	(princ "\nCreated/Edited by ajs@lisp.vn")
	(princ)
)
(defun c:22 ( / pt1 pt2 C_text O-Text N-text d i)
	(setq d 0 i 0)
	(while (setq pt1 (getpoint "\nSpecify first point: "))
		(if (setq pt2 (getpoint pt1 "Specify second point: "))
			(progn
				(setq d (+ d (distance pt1 pt2)))
				(princ (strcat "\nDelta X" (itoa (setq i (1+ i))) " = " (rtos (abs (- (car pt1) (car pt2))) 2 (getvar "LUPREC"))
					" Delta Y" (itoa i) " = " (rtos (abs (- (cadr pt1) (cadr pt2))) 2 (getvar "LUPREC")) 
					"  Total = " (rtos d 2 (getvar "LUPREC"))))
			)
		)
	)
	(setq C_text (rtos d 2 (getvar "LUPREC")))
	(setcliptext C_text)
	(princ (strcat "\nTotal " (itoa i)))
	(if (setq Text (car (nentsel (strcat "\nChon Text ghi ket qua [L = " C_text "]:"))))
		(progn		   ;	
			(setq N-Text (cons 1 C_text))
			(setq N-Text1 (subst N-Text (assoc 1 (entget Text)) (entget Text)))
			(entmod N-Text1)
			(setcliptext C_text)
		)
	)
	(princ "\nCreated/Edited by ajs@lisp.vn")
	(princ)
)

Link tải (MediaFire)

📥 https://www.mediafire.com/

---------------------------------------------------------------------------------------------

Ứng dụng được phát triển bởi đội ngũ AutoLISP Thật là đơn giản - Tác giả ứng dụng in D2P

    

Mọi thông tin xin liên hệ Fanpage AutoLISP Thật là đơn giản!

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