Chuyển đến nội dung
Diễn đàn CADViet
Lương Sơn

Nhờ sửa lisp pick diện tích

Các bài được khuyến nghị

Chào các bác. Em có xin được 1 lisp pick diện tích và thay số vào text có sẵn. Nhưng khi pick diện tích thì lisp chỉ hiện đường bao các vùng mình đã pick, cảm giác rất khó nhìn. Nên em muốn nhờ các bác sửa hộ em khi pick diện tích sẽ hatch luôn vùng mình pick. Em cảm ơn ạ.

AA- pick dien tich va thay so.lsp

Untitled.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
2 giờ trước, Lương Sơn đã nói:

Chào các bác. Em có xin được 1 lisp pick diện tích và thay số vào text có sẵn. Nhưng khi pick diện tích thì lisp chỉ hiện đường bao các vùng mình đã pick, cảm giác rất khó nhìn. Nên em muốn nhờ các bác sửa hộ em khi pick diện tích sẽ hatch luôn vùng mình pick. Em cảm ơn ạ.

AA- pick dien tich va thay so.lsp

Untitled.jpg

(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 "\nPick vung can tinh dien tich: ")
	(setq area 0.0)
	
	(sleep_osnap)
	
	(while (setq pt (getpoint str))
		(Command "bhatch" 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 "\nTong dien tich: " (rtos (getvar "AREA") 2 (getvar "LUPREC")) "/  Dien tich vung vua pick: " (rtos area 2 (getvar "LUPREC"))))					
			)			
		)
		(setq str "\nPick vung can tinh dien tich tiep theo: ")
	)
	
	(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 "Dien tich da duoc copy vao Clipboard")
	
	;;Thay doi noi dung text
	(if (setq O-Text (entsel (strcat "\nChon text de ghi dien tich: ")))
		(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
	(command "_change" O-Text "" "p" "c" "2" "")
	(princ)
)

Gửi bạn nhé

  • Like 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Vào lúc 5/11/2022 tại 14:45, huunhantvxdts đã nói:

(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 "\nPick vung can tinh dien tich: ")
	(setq area 0.0)
	
	(sleep_osnap)
	
	(while (setq pt (getpoint str))
		(Command "bhatch" 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 "\nTong dien tich: " (rtos (getvar "AREA") 2 (getvar "LUPREC")) "/  Dien tich vung vua pick: " (rtos area 2 (getvar "LUPREC"))))					
			)			
		)
		(setq str "\nPick vung can tinh dien tich tiep theo: ")
	)
	
	(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 "Dien tich da duoc copy vao Clipboard")
	
	;;Thay doi noi dung text
	(if (setq O-Text (entsel (strcat "\nChon text de ghi dien tich: ")))
		(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
	(command "_change" O-Text "" "p" "c" "2" "")
	(princ)
)

Gửi bạn nhé

em cảm ơn bác.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×