update theo haanh:

- Set layer cho ống & cút

- Xoá 3dpolyline

;lisp ve duong ong 3d
(defun c:VE(/ lst_va old D ss lst_TC_DUC cao_tam_cut net R path cut base_w lst_ver lst_w obj i ss_ong ss_cut n len dau cuoi)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
;=================
(setq D (getdist "\nNhap duong kinh ong: ")
	  lst_TC_DUC '((12 . 26.0) (13 . 26.0) (18 . 35.0) (19 ....
>>

update theo haanh:

- Set layer cho ống & cút

- Xoá 3dpolyline

;lisp ve duong ong 3d
(defun c:VE(/ lst_va old D ss lst_TC_DUC cao_tam_cut net R path cut base_w lst_ver lst_w obj i ss_ong ss_cut n len dau cuoi)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
;=================
(setq D (getdist "\nNhap duong kinh ong: ")
	  lst_TC_DUC '((12 . 26.0) (13 . 26.0) (18 . 35.0) (19 . 35.0) (22 . 40.0) (23 . 40.0) (28 . 
50.0) (29 . 50.0) (35 . 55.0) (34 . 55.0) (40 . 60.0) (52 . 70.0) (53 . 70.0) 
(70 . 80.0) (69 . 80.0) (85 . 90.0) (84 . 90.0) (104 . 100.0) (129 . 187.5) 
(154 . 225.0) (204 . 300.0) (254 . 375.0))
	  cao_tam_cut (cdr (assoc D lst_TC_DUC))
	  )	;setq
;=================
(prompt "\nChon 3DPOLY: ")
(setq ss (ssget "+.:E:S" '((0 . "POLYLINE"))))
(if (and
		D
		(member D (mapcar 'car lst_TC_DUC))
		ss)
	(progn
		(or #lan_ve (setq #lan_ve 0))
		(setq #lan_ve (1+ #lan_ve))
		;ve cut mau:
		(setq net (getvar "clayer"))
		(if (tblsearch "layer" "Cut_DN50") 
			(setvar "clayer" "Cut_DN50") 
			(command "layer" "m" "Cut_DN50" "c" "t" "45,159,225" "" "")
			)	;if
		(command "arc" "c" '(0 0 0) (list cao_tam_cut 0 0) (list 0 cao_tam_cut 0))
		(setq path (entlast))
		(command "circle" '(0 0 0) (setq R (/ D 2.0)))
		(command "sweep" (entlast) "" path)
		(setq cut (entlast))
		(setq base_w (mapcar '(lambda (x) (trans x 1 0)) (list (list cao_tam_cut 0 0) (list cao_tam_cut cao_tam_cut 0) (list 0 cao_tam_cut 0))))
		;== xong cut mau ==
		(if (tblsearch "layer" "Ong_DN50") 
			(setvar "clayer" "Ong_DN50") 
			(command "layer" "m" "Ong_DN50" "c" "t" "133,230,244" "" "")
			)	;if 
		;Luu UCS:
		(command "ucs" "na" "s" "save1_ucs")
		;(command "-view" "s" "save_v")
		;*******************************
		(setq lst_ver (acet-geom-vertex-list (setq ename (ssname ss 0)))
			  lst_w (mapcar '(lambda (x) (trans x 1 0)) lst_ver)
			  obj (vlax-ename->vla-object ename))
		(setq i 0
			  ss_ong (ssadd)
			  ss_cut (ssadd)
			  )
		(repeat (setq n (1- (length lst_w)))
			(setq len (distance (setq dau (nth i lst_w)) (setq cuoi (nth (1+ i) lst_w))))
			(command "UCS" "za" (trans dau 0 1) (trans cuoi 0 1))
			(cond
				((= i 0) (command "CYLINDER" (trans dau 0 1) R (- len cao_tam_cut))	;ve ong
					(setq ss_ong (ssadd (entlast) ss_ong))
					(3DDD cut  
						(trans (car base_w) 0 1) 
						(trans (cadr base_w) 0 1) 
						(trans (last base_w) 0 1) 
						(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1) 
						(trans (vlax-curve-getPointAtParam obj 1) 0 1) 
						(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj 1) cao_tam_cut)) 0 1))	;align_copy cut
					(setq ss_cut (ssadd (entlast) ss_cut))
				)
				((= i (1- n)) (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len cao_tam_cut))	;ve ong
					(setq ss_ong (ssadd (entlast) ss_ong))
				)	
				(t (command "CYLINDER" (mapcar '+ (list 0 0 cao_tam_cut) (trans dau 0 1)) R (- len (* 2 cao_tam_cut)))	;ve ong
					(setq ss_ong (ssadd (entlast) ss_ong))
					(3DDD cut 
						(trans (car base_w) 0 1) 
						(trans (cadr base_w) 0 1) 
						(trans (last base_w) 0 1) 
						(trans (vlax-curve-getPointAtDist obj (- (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1) 
						(trans (vlax-curve-getPointAtParam obj (1+ i)) 0 1) 
						(trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtParam obj (1+ i)) cao_tam_cut)) 0 1))		;align_copy cut
					(setq ss_cut (ssadd (entlast) ss_cut))
				)
			)
			(setq i (1+ i))
		)	;repeat
		;(command "-block" (strcat "Ong_" (rtos (getvar 'cdate) 2 4)) (trans (nth 0 lst_w) 0 1) ss_ong "")
		;(command "-block" (strcat "Cut_" (rtos (getvar 'cdate) 2 4)) (trans (nth 0 lst_w) 0 1) ss_cut "")
		(command "group" "c" (strcat "Ong_" (rtos (getvar 'cdate) 2 0) (itoa #lan_ve)) "Group_ong" ss_ong "")
		(command "group" "c" (strcat "Cut_" (rtos (getvar 'cdate) 2 0) (itoa #lan_ve)) "Group_cut" ss_cut "")
		;(mapcar 'entdel (list cut path))       ;Cai nay chay tren cad2014 thay co loi ko xoa path nen thay bang command
		(command ".ERASE" cut "")
		(command ".ERASE" path "")
		(command ".ERASE" ss "")
		(command "ucs" "na" "r" "save1_ucs")
		(command "ucs" "na" "d" "save1_ucs")
		;(command "-view" "r" "save_v")
		;(command "-view" "d" "save_v")
		(setvar "clayer" net)
	)
	(alert "***** Nhap du lieu chua dung ! *****")
)
(mapcar 'setvar lst_va old)
(princ)
)
(vl-load-com)
;*****************************************************************************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;=============================================================================================================================
(defun 3DDD(ss pt_a pt_b pt_c pt_1 pt_2 pt_3 / lst_va old lst_point_w moc new pre
huong_12_xoy huong_13_xoy huong_ab_xoy huong_ac_xoy 
huong_12_yoz huong_13_yoz huong_ab_yoz huong_ac_yoz 
huong_12_xoz huong_13_xoz huong_ab_xoz huong_ac_xoz 
pt_phu pt_phu_w pt_phu2 pt_phu2_w base truc truc_w ang anh anh_c anh_w pt_phu2_2d pt_phu2_w_3d pt_phu_2d pt_phu_3d pt_phu_w_3d)
;Ham 3dalign khong scale Voi 3 diem chon phai "bang nhau" ve kich thuoc hinh dang
(setq lst_va '("osmode" "cmdecho" "AUNITS" "ANGDIR"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0 3 0))
(setq lst_point_w (mapcar '(lambda (x) (trans x 1 0)) (list pt_a pt_b pt_c pt_1 pt_2 pt_3)))
(command "ucs" "na" "s" "save_ucs")
;(command "-view" "s" "save_v")
(setq moc (entlast) 
	  new (ssadd))
(command "_.copy" ss "" pt_a pt_1)
(while (setq pre (entnext moc))
	(setq new (ssadd pre new)
		  moc pre)
)	;while
;======================================================================
;Kiem tra trung phuong, chieu
(command "ucs" "za" '(0 0 0) '(2.357 1.312 4.235))
(setq huong_12_xoy (angle (nth 3 lst_point_w) (nth 4 lst_point_w))
	  huong_13_xoy (angle (nth 3 lst_point_w) (nth 5 lst_point_w))
	  huong_ab_xoy (angle (nth 0 lst_point_w) (nth 1 lst_point_w))
	  huong_ac_xoy (angle (nth 0 lst_point_w) (nth 2 lst_point_w))
	  )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
	  huong_13_yoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
	  huong_ab_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
	  huong_ac_yoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
	  )
(command "ucs" "za" '(0 0 0) '(1 0 0))
(setq huong_12_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 4 lst_point_w) 0 1))
	  huong_13_xoz (angle (trans (nth 3 lst_point_w) 0 1) (trans (nth 5 lst_point_w) 0 1))
	  huong_ab_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 1 lst_point_w) 0 1))
	  huong_ac_xoz (angle (trans (nth 0 lst_point_w) 0 1) (trans (nth 2 lst_point_w) 0 1))
	  )
(command "ucs" "na" "r" "save_ucs")
;=====================================================================
(cond
	((and 
		(equal huong_12_xoy huong_ab_xoy 1e-5) 
		(equal huong_12_yoz huong_ab_yoz 1e-5)
		(equal huong_12_xoz huong_ab_xoz 1e-5)
		)
		(cond
			((and 
				(equal huong_13_xoy huong_ac_xoy 1e-5) 
				(equal huong_13_yoz huong_ac_yoz 1e-5)
				(equal huong_13_xoz huong_ac_xoz 1e-5)
				)
				(princ "\nAlign = Copy ! ")
				(princ)
			)
			(t 
				(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
					  pt_phu_w (trans pt_phu 1 0))
				(command "ucs" "za" pt_1 pt_2)
				(command "rotate" new "" 
					(setq base (trans (nth 3 lst_point_w) 0 1))
					(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
					)
			)
		)
	)
	;========================================================
	((and 
		(or (equal (+ huong_12_xoy pi) huong_ab_xoy 1e-5) (equal (- huong_12_xoy pi) huong_ab_xoy 1e-5))
		(or (equal (+ huong_12_yoz pi) huong_ab_yoz 1e-5) (equal (- huong_12_yoz pi) huong_ab_yoz 1e-5))
		(or (equal (+ huong_12_xoz pi) huong_ab_xoz 1e-5) (equal (- huong_12_xoz pi) huong_ab_xoz 1e-5))
		)
			(setq truc (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
				  truc_w (trans truc 1 0))
			(setq anh (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
				  anh_w (trans anh 1 0))
			(command "ucs" "za" pt_1 truc)
			(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
			(setq pt_phu2_2d
				(polar 
						base 
						(+ pi (angle base (setq anh_c (trans anh_w 0 1)))) 
						(distance base (list (car anh_c) (cadr anh_c)))
						)
				pt_phu2_w_3d (trans (list (car pt_phu2_2d) (cadr pt_phu2_2d) (last anh_c)) 1 0)
				)
			(cond
				((and 
					(equal huong_13_xoy huong_ac_xoy 1e-5) 
					(equal huong_13_yoz huong_ac_yoz 1e-5)
					(equal huong_13_xoz huong_ac_xoz 1e-5)
					)
					(princ)
				)
				((and 
					(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
					(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
					(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
					)
					(command "ucs" "za" base (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ (trans pt_phu2_w_3d 0 1) (trans (nth 4 lst_point_w) 0 1))))
					(command "rotate" new "" (trans (nth 3 lst_point_w) 0 1) pi)
				)
				(t 
					(command "ucs" "3p" base (trans (nth 5 lst_point_w) 0 1) (trans truc_w 0 1))
					(command "rotate" new ""
						(setq base (trans (nth 3 lst_point_w) 0 1))
						(* -1 (angle base (trans truc_w 0 1)))
					)
				)
			)
	)
	;==================================================================
	(t 
		(cond
			((and 
					(equal huong_13_xoy huong_ac_xoy 1e-5) 
					(equal huong_13_yoz huong_ac_yoz 1e-5)
					(equal huong_13_xoz huong_ac_xoz 1e-5)
					)
					(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
						  pt_phu_w (trans pt_phu 1 0))
					(command "ucs" "za" pt_1 pt_3)
					(command "rotate" new "" 
						(setq base (trans (nth 3 lst_point_w) 0 1))
						(- (angle base (trans (nth 4 lst_point_w) 0 1)) (angle base (trans pt_phu_w 0 1)))
					)
			)
			((and 
					(or (equal (+ huong_13_xoy pi) huong_ac_xoy 1e-5) (equal (- huong_13_xoy pi) huong_ac_xoy 1e-5))
					(or (equal (+ huong_13_yoz pi) huong_ac_yoz 1e-5) (equal (- huong_13_yoz pi) huong_ac_yoz 1e-5))
					(or (equal (+ huong_13_xoz pi) huong_ac_xoz 1e-5) (equal (- huong_13_xoz pi) huong_ac_xoz 1e-5))
					)
					(setq truc (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
						  truc_w (trans truc 1 0))
					(setq anh (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
						  anh_w (trans anh 1 0))
					(command "ucs" "za" pt_1 truc)
					(command "rotate" new "" (setq base (trans (nth 3 lst_point_w) 0 1)) pi)
					(command "ucs" "3p" base (trans (nth 4 lst_point_w) 0 1) (trans truc_w 0 1))
					(command "rotate" new ""
						(setq base (trans (nth 3 lst_point_w) 0 1))
						(* -1 (angle base (trans truc_w 0 1)))
					)
			)
			(t
				(setq pt_phu (mapcar '+ pt_1 (mapcar '- pt_b pt_a))
					  pt_phu_w (trans pt_phu 1 0)
					  pt_phu2 (mapcar '+ pt_1 (mapcar '- pt_c pt_a))
					  pt_phu2_w (trans pt_phu2 1 0))
				(command "ucs" "3p" pt_1 pt_2 pt_phu)
				(command "rotate" new "" 
					(setq base (trans (nth 3 lst_point_w) 0 1)) 
					(setq ang (* -1 (angle base (trans pt_phu_w 0 1))))
				)
				(setq pt_phu_2d 
						(polar 
							base 
							(+ ang (angle base (setq anh_c (trans pt_phu2_w 0 1)))) 
							(distance (list (car base) (cadr base)) (list (car anh_c) (cadr anh_c))))
					  pt_phu_3d (list (car pt_phu_2d) (cadr pt_phu_2d) (last anh_c))
					  pt_phu_w_3d (trans pt_phu_3d 1 0))
				(command "ucs" "za" (trans (nth 3  lst_point_w) 0 1) (trans (nth 4  lst_point_w) 0 1))
				(command "rotate" new "" 
					(setq base (trans (nth 3 lst_point_w) 0 1))
					(- (angle base (trans (nth 5 lst_point_w) 0 1)) (angle base (trans pt_phu_w_3d 0 1)))
				)
			)
		)
	)
)
(command "ucs" "na" "r" "save_ucs")
(command "ucs" "na" "d" "save_ucs")
;(command "-view" "r" "save_v")
;(command "-view" "d" "save_v")
(mapcar 'setvar lst_va old)
(princ)
)

Lisp theo ý haanh đây ! Lệnh: TKO để thống kê ống & TKC để thống kê cút

;Lisp thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
;(setq lst_data_TC_DUC '(()))
(setq sam (assoc 8 (entget(car(entsel "\nChon ong mau: "))))
	  D (getdist "\nNhap duong kinh tu ban phim hoac pick chon 2 diem de nhap duong...
>>

Lisp theo ý haanh đây ! Lệnh: TKO để thống kê ống & TKC để thống kê cút

;Lisp thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
;(setq lst_data_TC_DUC '(()))
(setq sam (assoc 8 (entget(car(entsel "\nChon ong mau: "))))
	  D (getdist "\nNhap duong kinh tu ban phim hoac pick chon 2 diem de nhap duong kinh: "))
(prompt "\Chon cac ong can thong ke chieu dai: ")
(setq ss (ssget (list '(0 . "3DSOLID") sam))
	  ss (ss2lst ss)
	  tong 0)
(foreach elem ss
	(command ".area" "o" elem)
	(setq S (getvar 'area)
		  L (/ (- S (* 2 pi 0.25 D D)) (* pi D))
		  tong (+ L tong))
)	;for
(princ (strcat "\nTong chieu dai " (cdr sam) " la: " (rtos tong 2 3) " (don vi ve)"))
(mapcar 'setvar lst_va old)
(princ)
)
;===================================================================
;Lisp thong ke cut
(defun c:TKC( / sam ss cmd)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq sam (assoc 8 (entget(car(entsel "\nChon cut mau: ")))))
(prompt "\Chon cac cut can thong ke so luong: ")
(setq ss (ssget (list '(0 . "3DSOLID") sam)))
(princ (strcat "\nTong so " (cdr sam) " la: " (itoa (sslength ss)) " (cai)"))
(setvar 'cmdecho cmd)
(princ)
)
;===================================================================
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
	(setq ename (ssname ss i)
		  i (1+ i)
		  lst (cons ename lst))
)
(reverse lst)
)

Là bản demo nên còn chút rườn rà, Nếu người dùng quản lý layer tốt thì có thể lấy thông tin đường kính ống thông qua thông tin về layer (do là 3dsolid nên quá khó để moi móc thông tin của autodesk - cao thủ nào có cách xin đc chỉ giáo) >>> bỏ qua đc 1 bước ngoằn ngoèo nhập đường kính.

- he đc về sớm, sao nhoc test thử vd bạn ấy đưa lsp vẫn trả về đúng 2487 mà ta @@, vậy là sao nhỉ,lúc đầu nhoc ko nhớ nên nghĩ 0.5 trở xuống thì rtos nó ko làm tròn ^^, mà kết quả trùng bình 2 số, 1 là tròn 2 là lẽ 0.5

- nhoc thêm đk phụ có thể dư, bạn cứ thử xem sao, thêm cái đk nếu đối tượng bạn chọn để ghi LTB ko phải text sẽ bắt bạn chọn đúng mới thui, L delta củng vậy...

- he đc về sớm, sao nhoc test thử vd bạn ấy đưa lsp vẫn trả về đúng 2487 mà ta @@, vậy là sao nhỉ,lúc đầu nhoc ko nhớ nên nghĩ 0.5 trở xuống thì rtos nó ko làm tròn ^^, mà kết quả trùng bình 2 số, 1 là tròn 2 là lẽ 0.5

- nhoc thêm đk phụ có thể dư, bạn cứ thử xem sao, thêm cái đk nếu đối tượng bạn chọn để ghi LTB ko phải text sẽ bắt bạn chọn đúng mới thui, L delta củng vậy ^^

(defun c:TTL (/ old lmax lmin ename1 ename2 info1 info2 dai1 dai2 ltb ldelta e1 e2) ;
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai be nhat:")
(setq lmin (ssget "+.:E:S" '((0 . "LINE"))))
(if lmin
 (progn
    (setq ename1 (ssname lmin 0)
	      info1 (entget ename1)
		  dai1 (distance (cdr (assoc 10 info1)) (cdr (assoc 11 info1)))
	 )
  )
)  
 ;=========================================================
(prompt "Chon thanh co chieu dai lon nhat:")
(setq lmax (ssget "+.:E:S" '((0 . "LINE"))))
(if lmax
 (progn
    (setq ename2 (ssname lmax 0)
	      info2 (entget ename2)
		  dai2 (distance (cdr (assoc 10 info2)) (cdr (assoc 11 info2)))
	 )
  )
)  
;===========================================================
(setq sl (getint "\nSo luong thanh mun tinh:"))
(setq ltb (* (/ (+ dai1 dai2) 2.0) 1000))
(if (= (- ltb (fix ltb)) 0.5)
(setq ltb (+ ltb 0.5))
ltb
)
(setq ldelta (* (/ (- dai2 dai1) (- sl 1)) 1000))
;==============================================================
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e1)) "TEXT")
(prompt "Ban chon ko phai la text, ban chon lai hen!!!")
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(princ "\n")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(entmod (subst (cons 1 (strcat "Thanh'" (itoa (- sl 1)) ",L = " (rtos ltb 2 0))) (assoc 1 e1) e1))
;===============================================================
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e2)) "DIMENSION")
(prompt "doi tuong ban chon ko phai la dim, ban chon lai hen!!!")
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(princ "\n")
)
(entmod (subst (cons 1 (strcat (rtos (* dai1 1000) 2 0) "~" (rtos (* dai2 1000) 2 0) ", \U+0394L=" (rtos ldelta 2 0))) (assoc 1 e2) e2))
;======================================================================
(setvar "osmode" old)
(princ "\n")
(princ)
)

Nhoclangbat nên cho thêm tỷ lệ vào, như vậy sẽ điều chỉnh được kích thước.

Hoặc cho thêm cái LISP thay đổi kích thước Text cho bạn ấy.

(defun C:DKT (/  ss item temp);DOI KICH THUOC
(vl-load-com)
(setvar "CMDECHO" 0)
(or *Chieucao* (setq *Chieucao* 1.0))
(setq Chieucao (getreal (strcat "\n Nh\U+1EADp chi\U+1EC1u cao Text c\U+1EA7n thay \U+0111\U+1ED5i <"
				(rtos *Chieucao* 2 2)
			        ">...
>>

Nhoclangbat nên cho thêm tỷ lệ vào, như vậy sẽ điều chỉnh được kích thước.

Hoặc cho thêm cái LISP thay đổi kích thước Text cho bạn ấy.

(defun C:DKT (/  ss item temp);DOI KICH THUOC
(vl-load-com)
(setvar "CMDECHO" 0)
(or *Chieucao* (setq *Chieucao* 1.0))
(setq Chieucao (getreal (strcat "\n Nh\U+1EADp chi\U+1EC1u cao Text c\U+1EA7n thay \U+0111\U+1ED5i <"
				(rtos *Chieucao* 2 2)
			        "> :"
		        )
	       )
)
(if (not Chieucao) (setq Chieucao *Chieucao*) (setq *Chieucao* Chieucao))
(if (setq ss (ssget (list (cons 0  "TEXT"))))
	(progn
	      (setq ss (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
	      (mapcar '(lambda (x) (entmod (subst (cons 40 Chieucao) (assoc 40 (entget x)) (entget x) ))) ss)
	)
)
(princ)
)

(defun c:acb(/ oldlayer ra ty p1 p2)
(setq oldlayer (getvar "CLAYER")
ra 5)
(if (not (tblsearch "layer" "MSL-CLOUD"))
(command ".layer" "M" "MLS-CLOUD" "C" "5" "" "L" "Continuous" "" "")
( setvar "clayer" "MLS-CLOUD"))
(setq ty (strcase(getstring "\nThe type of cloudmark :")))
(cond ((= ty "R");types
(setq p1 (getpoint "\nDiem dau HCN")
p2 (getcorner p1 "\nDiem Cuoi HCN:"))
(command ".rectangle" p1 p2)
(command ".revcloud" "A" ra "" "O"...

(defun c:acb(/ oldlayer ra ty p1 p2)
(setq oldlayer (getvar "CLAYER")
ra 5)
(if (not (tblsearch "layer" "MSL-CLOUD"))
(command ".layer" "M" "MLS-CLOUD" "C" "5" "" "L" "Continuous" "" "")
( setvar "clayer" "MLS-CLOUD"))
(setq ty (strcase(getstring "\nThe type of cloudmark :")))
(cond ((= ty "R");types
(setq p1 (getpoint "\nDiem dau HCN")
p2 (getcorner p1 "\nDiem Cuoi HCN:"))
(command ".rectangle" p1 p2)
(command ".revcloud" "A" ra "" "O" (entlast) ""))
((/= ty "R") (command ".pline")(while (= 1 (logand 1 (getvar 'cmdactive)))
(command "\\")
);end while
(command ".revcloud" "A" ra "" "O" (entlast) ""))
);end cond
(setvar "CLAYER" oldlayer)
(princ)
)

Các bạn cho mình hỏi: sau khi active cái layer "MLS-CLOUD", nếu chưa thực hiện xong lisp mà mình nhấn ESC để thoát ra, không thực hiện tiếp thì làm thế nào để kích hoạt lại cái oldlayer?

Không nên bỏ dòng (*error* msg) vì nhờ nó mình mới biết sai chỗ nào.

Khi định nghĩa lại hàm *error* thì bạn phải trả lại mặc định của nó, chỉ thêm những cái cần thêm thôi, nếu bạn xóa dòng đó thì coi như bạn vô hiệu hóa hàm đó rồi.

Do bạn...

Không nên bỏ dòng (*error* msg) vì nhờ nó mình mới biết sai chỗ nào.

Khi định nghĩa lại hàm *error* thì bạn phải trả lại mặc định của nó, chỉ thêm những cái cần thêm thôi, nếu bạn xóa dòng đó thì coi như bạn vô hiệu hóa hàm đó rồi.

Do bạn viết không đúng ở cái dòng (if (not (tblsearch "layer" "MSL-CLOUD")) ... cho nên mới có thông báo vậy.

Viết lại cái lsp của bạn như sau, bạn test thử xem còn bị thông báo "type ..." nữa không.

 
(defun c:acb(/ oldlayer ra ty p1 p2)
(setq oldlayer (getvar "CLAYER")
      ra 5)
(if (not (tblsearch "layer" "MSL-CLOUD"))
  (command ".layer" "M" "MLS-CLOUD" "C" "5" "" "L" "Continuous" "" "")
)
( setvar "clayer" "MLS-CLOUD")
(setq ty (strcase(getstring "\nThe type of cloudmark :")))
(cond ((= ty "R");types
       (setq p1 (getpoint "\nDiem dau HCN")
    p2 (getcorner p1 "\nDiem Cuoi HCN:"))
       (command ".rectangle" p1 p2)
       (command ".revcloud" "A" ra "" "O" (entlast) ""))
 
      ((/= ty "R") (command ".pline")
        (while (= 1 (logand 1 (getvar 'cmdactive)))
  (command "\\"));end while
       (command ".revcloud" "A" ra "" "O" (entlast) ""))
);end cond
(setvar "CLAYER" oldlayer)
(princ)
) 
 
 

- có hàm này bãy lỗi tốt thật nhưng nhoc vẫn chưa hiểu nó ^^, có xem vài box nói về nó nhưng thấy nó cứ vòng vòng lẫn quẫn,như a Tot77 gợi ý viết vậy đc ko hỉ ^^

(defun bayloi (nhacloi)	
(setvar "osmode" oldos)	
(setvar "clayer" oldlay)
(setvar "cmdecho" oldcmd)
(setq *error* luuham)	
(prompt "\nxin tra lai e tat ca ^^!!!")	
(princ)
)
(defun c:test()
(setq luuham *error*)
(setq *error*...
>>

- có hàm này bãy lỗi tốt thật nhưng nhoc vẫn chưa hiểu nó ^^, có xem vài box nói về nó nhưng thấy nó cứ vòng vòng lẫn quẫn,như a Tot77 gợi ý viết vậy đc ko hỉ ^^

(defun bayloi (nhacloi)	
(setvar "osmode" oldos)	
(setvar "clayer" oldlay)
(setvar "cmdecho" oldcmd)
(setq *error* luuham)	
(prompt "\nxin tra lai e tat ca ^^!!!")	
(princ)
)
(defun c:test()
(setq luuham *error*)
(setq *error* bayloi)
(......)
(setq *error* luuham)
)

Nên để hàm bayloi vao trong lệnh test, để chỉ khi lỗi trong lệnh này nó xử lý thôi. Còn lệnh khác bãy cái khác, Riêng cái câu (setq luuham *error*) thì có thể để bên ngoài (để phòng xa xem như đã lưu hàm gốc ở nơi an toàn vậy mà).

(setq luuham *error*)
(defun c:test()  
  (defun bayloi (nhacloi) 
    (setvar "osmode" oldos) 
    (setvar "clayer" oldlay)
    (setvar "cmdecho"...
>>

Nên để hàm bayloi vao trong lệnh test, để chỉ khi lỗi trong lệnh này nó xử lý thôi. Còn lệnh khác bãy cái khác, Riêng cái câu (setq luuham *error*) thì có thể để bên ngoài (để phòng xa xem như đã lưu hàm gốc ở nơi an toàn vậy mà).

(setq luuham *error*)
(defun c:test()  
  (defun bayloi (nhacloi) 
    (setvar "osmode" oldos) 
    (setvar "clayer" oldlay)
    (setvar "cmdecho" oldcmd)
    (setq *error* luuham) 
    (prompt "\nxin tra lai e tat ca ^^!!!") 
    (princ)
  )
  (setq *error* bayloi)
  (......)
)

- anh Tott ơi nhoc mót của anh viết thử gần đc mà hình như trục trặc chỗ nào nhoc ko mò ra nỗi ^^, giúp nhoc với

;================================================================================================
(defun getp(v / l1 l2 lst)
(setvar "cmdecho" 0)
    ;(if (or (= "LINE" (cdr (assoc 0 (entget v)))) (= "LINE" (cdr (assoc 0 (entget v)))))
     ;(progn
      (setq l1 (list (list (cdr (assoc 10 (entget v))) (cdr (assoc 11...
>>

- anh Tott ơi nhoc mót của anh viết thử gần đc mà hình như trục trặc chỗ nào nhoc ko mò ra nỗi ^^, giúp nhoc với

;================================================================================================
(defun getp(v / l1 l2 lst)
(setvar "cmdecho" 0)
    ;(if (or (= "LINE" (cdr (assoc 0 (entget v)))) (= "LINE" (cdr (assoc 0 (entget v)))))
     ;(progn
      (setq l1 (list (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))
      (setq l2 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))
       (setq lst (append l1 l2))
      ;)    
    ;)
    (mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) lst)
  )
;==================================================================================================================
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;========================================================================================
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;====================================================================================
(defun c:raib()
(setvar "osmode" 0)
;==================================================================
(defun taoblock ()
(vl-load-com)
(setvar "osmode" 0) (setvar "cmdecho" 0)
(if (null (tblsearch "layer" "diem-cam"))
		(_layer2 "diem-cam" 1))
(makeline '(9.0 9.0 0.0) '(11.0 9.0 0.0) "diem-cam" nil nil nil)
(makeline '(10.0 10.0 0.0) '(10.0 8.0 0.0) "diem-cam" nil nil nil)
(ssget "X" '((0 . "LINE") (8 . "diem-cam")))
(vl-cmdf "-block" "diem_cam" '(10.0 9.0 0.0) "p" "")
)
(if (null (tblsearch "BLOCK" "diem_cam"))
(taoblock)
)
;==========================================================================
(prompt "chon doi tuong:")
(mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
)

- nhoc test nó cứ sót điểm cuối với line, line đơn thì ko insert đc điểm 11, còn nối tiếp thì ko đc điểm cuối cùng, pline ok

- chạy xong nó cứ báo lỗi này

Command: RAIB hcon doi tuong:
Select objects: Specify opposite corner: 3 found
Select objects:  Application ERROR: Invalid entity/point list.
Application ERROR: Invalid entity/point list.
Application ERROR: Invalid entity/point list.
((nil T) (nil T) (nil T))
 

- hàm getp nhoc mượn của anh nhưng nhoc chưa hiểu lắm, có thể là do hàm này nhoc chỉnh lại sai ^^

"Dự án" đã sơ bộ thành công !

Khoe hàng & chờ gạch đá :D :D :D

p/s: Không biết lỗi do code hay tại cấu hình máy mình kém hay tại cái lý do ban đầu mình nói mà có lúc bắn (pick) được có lúc không !

Mong được sự góp ý !!!

;game bong bong
(defun c:GAME3( / R BL TR xmin ymin ci lst_e_time count mark)
(setq #level (NGT #level 1 getint "nhap level"))
(setq count...
>>

"Dự án" đã sơ bộ thành công !

Khoe hàng & chờ gạch đá :D :D :D

p/s: Không biết lỗi do code hay tại cấu hình máy mình kém hay tại cái lý do ban đầu mình nói mà có lúc bắn (pick) được có lúc không !

Mong được sự góp ý !!!

;game bong bong
(defun c:GAME3( / R BL TR xmin ymin ci lst_e_time count mark)
(setq #level (NGT #level 1 getint "nhap level"))
(setq count 0 mark 0)
(repeat 5
(repeat (1+ (fix (random-n 5)))
	(setq R (* (expt 0.75 #level) (/ (getvar"viewsize") 15)))
	(MC 
		(list 
			(+ R 
				(setq xmin (car (setq BL (get-coordinate-screen "BL")))) 
				(random-n (- (car (setq TR (get-coordinate-screen "TR"))) xmin (* 2 R)))
				)
			(+ R 
				(setq ymin (cadr BL)) 
				(random-n (- (cadr TR) ymin (* 2 R)))
				)
		)
		R
		nil
		#level
	)
	(setq ci (entlast)
		  lst_e_time (cons (cons ci (getvar 'millisecs)) lst_e_time)
		  count (1+ count))
)
(while lst_e_time
	(setq lst_e_time (vl-remove nil 
						(mapcar '(lambda (x) 
							(cond 
								((> (/ (- (getvar 'millisecs) (cdr x)) 1000)  (* (expt 0.9 #level) 5))
									(command ".erase" (car x) "")
									(redraw)
								)
								((and (princ "\nBan !") (= (car (setq input (grread T 5 2))) 3) (setq pt (cadr input)) (< (distance pt (cdr (assoc 10 (entget (car x))))) R))
									(setq mark (1+ mark))
									(command ".erase" (car x) "")
									(redraw)
								)
								(t x)
							))
							lst_e_time)))
)
)
(alert (strcat "\nXac suat ban trung: " (rtos (* 100 (/ mark count 1.)) 2 3) " % !"))
(princ)
)
;========================================================================
;entmake circle
(defun MC(cen r layer color / lst1 lst2 lst)
(setq lst1 
	(list
		'(0 . "CIRCLE") 
		'(100 . "AcDbEntity") 
		(cons 8 (if layer layer (getvar 'clayer))) 
		)
	lst2
	(list
		'(100 . "AcDbCircle") 
		(cons 10 cen) 
		(cons 40 r) 
		)
)
(setq lst (if color (append lst1 (list (cons 62 color)) lst2) (append lst1 lst2)))
(entmake lst)
)
;=========================================================================
(defun get-coordinate-screen (coner / Y1 X1)
  (cond ((= (strcase coner) "BL")
	 (polar
		(polar
			(getvar "viewctr")
			(* -0.5 pi) 
			(setq Y1 (* 0.5 (getvar"viewsize")))
			) 
		pi 
		(/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1))
		))
	((= (strcase coner) "TR")
	 (polar
		(polar
			(getvar "viewctr")
			(* 0.5 pi)
			(setq Y1 (* 0.5 (getvar"viewsize")))
			) 
		0 
		(/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1))
		))
	)
)
;==========================================================================
;Chom duoc tu GiaBach cadviet.com ^^ ===> sua first seed theo ndtnv
(defun random ()
    (setq seed (if seed
		 (rem (+ (* seed 15625.7) 0.21137152) 1)
		 (/ (rem (getvar 'millisecs) 10000) 10000.)
	     )  
	)
)
(defun random-n (n) (* n (random)))
;===========================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)

Vậy là chắc chắn 1 điều: ở máy bác ko nhận đúng hàm MC (make circle) của em ^^

>>> Nhét nó vào luôn trong thân game bác nhé !

*** Bác thương em, test cho phát nữa ! ***

Thanks !

;game bong bong
(defun c:GAME3( / R BL TR xmin ymin ci lst_e_time count mark MC get-coordinate-screen random random-n NGT)
;entmake circle
(defun MC(cen r layer color / lst1 lst2 lst)
(setq lst1
  ...
>>

Vậy là chắc chắn 1 điều: ở máy bác ko nhận đúng hàm MC (make circle) của em ^^

>>> Nhét nó vào luôn trong thân game bác nhé !

*** Bác thương em, test cho phát nữa ! ***

Thanks !

;game bong bong
(defun c:GAME3( / R BL TR xmin ymin ci lst_e_time count mark MC get-coordinate-screen random random-n NGT)
;entmake circle
(defun MC(cen r layer color / lst1 lst2 lst)
(setq lst1
    (list
        '(0 . "CIRCLE")
        '(100 . "AcDbEntity")
        (cons 8 (if layer layer (getvar 'clayer)))
        )
    lst2
    (list
        '(100 . "AcDbCircle")
        (cons 10 cen)
        (cons 40 r)
        )
)
(setq lst (if color (append lst1 (list (cons 62 color)) lst2) (append lst1 lst2)))
(entmake lst)
)
;=========================================================================
(defun get-coordinate-screen (coner / Y1 X1)
  (cond ((= (strcase coner) "BL")
     (polar
        (polar
            (getvar "viewctr")
            (* -0.5 pi)
            (setq Y1 (* 0.5 (getvar"viewsize")))
            )
        pi
        (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1))
        ))
    ((= (strcase coner) "TR")
     (polar
        (polar
            (getvar "viewctr")
            (* 0.5 pi)
            (setq Y1 (* 0.5 (getvar"viewsize")))
            )
        0
        (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1))
        ))
    )
)
;==========================================================================
;Chom duoc tu GiaBach cadviet.com ^^ ===> sua first seed theo ndtnv
(defun random ()
    (setq seed (if seed
         (rem (+ (* seed 15625.7) 0.21137152) 1)
         (/ (rem (getvar 'millisecs) 10000) 10000.)
         )  
    )
)
(defun random-n (n) (* n (random)))
;===========================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
    ((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
    (modul)
    (a)
    )
    )
)
;============================================================================
;main
(setq #level (NGT #level 1 getint "nhap level"))
(setq count 0 mark 0)
(repeat 5
(repeat (1+ (fix (random-n 5)))
    (setq R (* (expt 0.75 #level) (/ (getvar"viewsize") 15)))
    (MC
        (list
            (+ R
                (setq xmin (car (setq BL (get-coordinate-screen "BL"))))
                (random-n (- (car (setq TR (get-coordinate-screen "TR"))) xmin (* 2 R)))
                )
            (+ R
                (setq ymin (cadr BL))
                (random-n (- (cadr TR) ymin (* 2 R)))
                )
        )
        R
        nil
        #level
    )
    (setq ci (entlast)
          lst_e_time (cons (cons ci (getvar 'millisecs)) lst_e_time)
          count (1+ count))
)
(while lst_e_time
    (setq lst_e_time (vl-remove nil
                        (mapcar '(lambda (x)
                            (cond
                                ((> (/ (- (getvar 'millisecs) (cdr x)) 1000)  (* (expt 0.9 #level) 5))
                                    (command ".erase" (car x) "")
                                    (redraw)
                                )
                                ((and (princ "\nBan !") (= (car (setq input (grread T 5 2))) 3) (setq pt (cadr input)) (< (distance pt (cdr (assoc 10 (entget (car x))))) R))
                                    (setq mark (1+ mark))
                                    (command ".erase" (car x) "")
                                    (redraw)
                                )
                                (t x)
                            ))
                            lst_e_time)))
)
)
(alert (strcat "\nXac suat ban trung: " (rtos (if (= 0 count) 100.0 (* 100 (/ mark count 1.))) 2 3) " % !"))
(princ)
;==========================End main==============================================
)

Cái này cũng gần giống cái trên.

(defun c:tty  (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                          (vlax-invoke-method
                           ...
>>

Cái này cũng gần giống cái trên.

(defun c:tty  (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                          (vlax-invoke-method
                            (vlax-get-property xlApp "Workbooks")
                            "Add") "Sheets") "Item" 1) "Cells") row 0 col 1)
  (vla-put-visible xlApp :vlax-true)
  
  (while (setq ss (ssget '((0 . "*TEXT"))))      
      (setq ss (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'InsertionPoint)
 (vlax-ename->vla-object x))) 
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))    
      (while ss
(setq  ss (vl-sort ss '(lambda (x y) (> (cadr (car x)) (cadr (car y)))))
      ss1 (vl-remove-if-not '(lambda (x) (equal (cadr (caar ss)) (cadr (car x)) 0.2)) ss)
      ss1 (vl-sort ss1 '(lambda (x y) (< (caar x) (caar y))))
      ss (vl-remove-if '(lambda (x) (member x ss1)) ss)
)
(foreach z ss1
          (setq iPt (car z)
y (list (vla-get-TextString (last z))  (rtos (car iPt) 2 2)  (rtos (cadr iPt) 2 2) (rtos (caddr iPt) 2 2))
 ) 
          (if (> row 65536) (setq col 5))
          (setq i -1 row (1+ row))
          (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) y)
)
      )
    )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (princ)
)

Đã thử test theo cách của Két, nhưng vẫn ko phát hiện ra điều gì mới ^^

Đành thay (= (car (setq input (grread T 5 2))) 3) thành (= (car (setq input (grread T 5 2))) 5) để lấy điểm nhanh hơn tí !

Sửa sang, chỉnh chu 1 chút nữa:

  - Cho bóng di động

  - Luyện thêm hàm bẫy lỗi (đề tài...

Đã thử test theo cách của Két, nhưng vẫn ko phát hiện ra điều gì mới ^^

Đành thay (= (car (setq input (grread T 5 2))) 3) thành (= (car (setq input (grread T 5 2))) 5) để lấy điểm nhanh hơn tí !

Sửa sang, chỉnh chu 1 chút nữa:

  - Cho bóng di động

  - Luyện thêm hàm bẫy lỗi (đề tài Nhóc hỏi hôm qua)

p/s:

Công trình hơi khủng ^ ^, thầy Két cho bỏ qua công đoạn phân tích code nhé !

:D :D :D

;game bong bong
(grtext -1 "hiepttr")
(defun c:GAME3( / R BL TR xmin ymin ci lst_e_time count mark MC get-coordinate-screen random random-n NGT cen-c info)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (setvar "cmdecho" cmd)
    (setq *error* temperr)
	(princ "\n*** End game ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
;=======================================================
;entmake circle
(defun MC(cen r layer color / lst1 lst2 lst)
(setq lst1 
	(list
		'(0 . "CIRCLE") 
		'(100 . "AcDbEntity") 
		(cons 8 (if layer layer (getvar 'clayer))) 
		)
	lst2
	(list
		'(100 . "AcDbCircle") 
		(cons 10 cen) 
		(cons 40 r) 
		)
)
(setq lst (if color (append lst1 (list (cons 62 color)) lst2) (append lst1 lst2)))
(entmake lst)
)
;=========================================================================
(defun get-coordinate-screen (coner / Y1 X1)
  (cond ((= (strcase coner) "BL")
	 (polar
		(polar
			(getvar "viewctr")
			(* -0.5 pi) 
			(setq Y1 (* 0.5 (getvar "viewsize")))
			) 
		pi 
		(/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))
		))
	((= (strcase coner) "TR")
	 (polar
		(polar
			(getvar "viewctr")
			(* 0.5 pi)
			(setq Y1 (* 0.5 (getvar "viewsize")))
			) 
		0 
		(/(* Y1 (car(setq X1 (getvar "screensize"))))(cadr X1))
		))
	)
)
;==========================================================================
;Chom duoc tu GiaBach cadviet.com ^^ ===> sua first seed theo ndtnv
(defun random ()
    (setq seed (if seed
		 (rem (+ (* seed 15625.7) 0.21137152) 1)
		 (/ (rem (getvar 'millisecs) 10000) 10000.)
	     )  
	)
)
(defun random-n (n) (* n (random)))
;===========================================================================
(defun NGT(a mac_dinh ham str_nhac / modul)
;;Nhan gia tri
(or a (setq a mac_dinh))
(setq a (cond
	((= "" (setq modul (ham (strcat "\n" str_nhac " <" (vl-princ-to-string a) ">: ")))) a)
	(modul)
	(a)
	)
	)
)
;=========================================================================================================================
;=================================================******************************==========================================
;main
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq #level (NGT #level 1 getint "nhap level"))
(setq count 0 mark 0)
(repeat 10
;=================
;make cir
(repeat (1+ (fix (random-n 5)))
	(setq R (* (expt 0.9 #level) (/ (getvar "viewsize") 15)))
	(MC 
		(list 
			(+ R 
				(setq xmin (car (setq BL (get-coordinate-screen "BL")))) 
				(random-n (- (car (setq TR (get-coordinate-screen "TR"))) xmin (* 2 R)))
				)
			(+ R 
				(setq ymin (cadr BL)) 
				(random-n (- (cadr TR) ymin (* 2 R)))
				)
		)
		R
		nil
		#level
	)
	(setq ci (entlast)
		  lst_e_time (cons (cons ci (getvar 'millisecs)) lst_e_time)
		  count (1+ count))
)
;=========end make cir ===========================
(while lst_e_time 
	(mapcar '(lambda (x) (setq info (entget (car x)))
						(entmod (subst 
									(cons 10
										(list 
											(+ (* (/ R 3) (expt -1 (if (> (random) 0.5) 1 2))) (cadr (setq cen-c (assoc 10 info))))
											(+ (* (/ R 3) (expt -1 (if (> (random) 0.5) 1 2))) (caddr cen-c))
											0
											))
									cen-c
									info))
						(command "delay" (fix (/ 200 (expt 1.2 #level))))
						)
			lst_e_time)
	(setq lst_e_time (vl-remove nil 
						(mapcar '(lambda (x) 
							(cond 
								((> (/ (- (getvar 'millisecs) (cdr x)) 1000)  (* (expt 0.85 #level) 3))
									(command ".erase" (car x) "")
									;(redraw)
								)
								((and (princ "\nDua chuot vao trong bong de gi diem !") (= (car (setq input (grread T 5 2))) 5) (setq pt (cadr input)) (< (distance pt (cdr (assoc 10 (entget (car x))))) R))
									(setq mark (1+ mark))
									(command ".erase" (car x) "")
									;(redraw)
								)
								(t x)
							))
							lst_e_time)))
)
)
(alert (strcat "\nXac suat ban trung: " (rtos (setq point (if (= 0 count) 100.0 (* 100 (/ mark count 1.)))) 2 3) " % !
\n" (cond 
		((< point 30) "Chua du noi luc de chuong !")
		((< point 60) "On ! Co the thu level tiep theo !")
		(t "Very well ! Typing the enter key twice to select next level !")
		)))
(setvar 'cmdecho cmd)
(setq *error* temperr)	;tra ham erorr nguyen thuy
(princ)
)

- nhoc mò mẫn lại, làm đc tới đây rùi làm theo ý bạn Hiep gợi ý nhưng sao khi là line nối tiếp nhau nó vẫn bị dư 1 block ngay chỗ nối, vẫn ko loại đc phần tử giống nhau hix

- còn pline nếu nó ko khép bằng close mà khép = bắt điểm thì cũng bị dư 1 điểm, đặt thêm đk thế nào mấy anh nhỉ

- còn 2 e này nữa thui là tốt rùi mà ko ko biết xử sao, mấy anh vớt giúp nhoc ^^

>>

- nhoc mò mẫn lại, làm đc tới đây rùi làm theo ý bạn Hiep gợi ý nhưng sao khi là line nối tiếp nhau nó vẫn bị dư 1 block ngay chỗ nối, vẫn ko loại đc phần tử giống nhau hix

- còn pline nếu nó ko khép bằng close mà khép = bắt điểm thì cũng bị dư 1 điểm, đặt thêm đk thế nào mấy anh nhỉ

- còn 2 e này nữa thui là tốt rùi mà ko ko biết xử sao, mấy anh vớt giúp nhoc ^^

(defun getp(v / l1 l2 l3)
(setvar "cmdecho" 0)
(cond 
    ((= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v)))))
	  (setq l3 nil)
	  (foreach x l1
	        (if (not (member x l3)) (setq l3 (cons x l3)))
		)
	  (mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) l3)
	)
	  
	((= "LWPOLYLINE" (cdr (assoc 0 (entget v))))
      (setq l2 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v))))
       (mapcar '(lambda(y) (vl-cmdf "-insert" "diem_cam" y 1 "" 0)) l2)
      )    
  )
    
)
;===============
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;========================================================================================
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;====================================================================================
(defun c:raib()
(setvar "osmode" 0)
;==================================================================
(defun taoblock ()
(vl-load-com)
(setvar "osmode" 0) (setvar "cmdecho" 0)
(if (null (tblsearch "layer" "diem-cam"))
		(_layer2 "diem-cam" 1))
(makeline '(9.0 9.0 0.0) '(11.0 9.0 0.0) "diem-cam" nil nil nil)
(makeline '(10.0 10.0 0.0) '(10.0 8.0 0.0) "diem-cam" nil nil nil)
(ssget "X" '((0 . "LINE") (8 . "diem-cam")))
(vl-cmdf "-block" "diem_cam" '(10.0 9.0 0.0) "p" "")
)
(if (null (tblsearch "BLOCK" "diem_cam"))
(taoblock)
)
;==========================================================================
(prompt "chon doi tuong:")
(mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
(princ "\n")
(princ)
)
;============================

Nhoclangbat thử cái này anh vừa viết xem sao

(defun c:CBL (/ TenBlock  Lts_EnameLine Lts_EnamePLine Lt1 Lt2 Lts LtsFilter  )
(vl-load-com)
(setvar "CMDECHO" 0)
(setq TenBlock (getstring "\n Nh\U+1EADp t\U+00EAn Block / Enter \U+0111\U+1EC3 ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng:  "))
(if (= TenBlock "") (setq TenBlock (cdr (assoc 2 (entget (car (entsel "\n Chon Block :")))))))
(Alert (strcat "\nQuet chon LINE, POLYLINE: "))
(setq ss...
>>

Nhoclangbat thử cái này anh vừa viết xem sao

(defun c:CBL (/ TenBlock  Lts_EnameLine Lts_EnamePLine Lt1 Lt2 Lts LtsFilter  )
(vl-load-com)
(setvar "CMDECHO" 0)
(setq TenBlock (getstring "\n Nh\U+1EADp t\U+00EAn Block / Enter \U+0111\U+1EC3 ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng:  "))
(if (= TenBlock "") (setq TenBlock (cdr (assoc 2 (entget (car (entsel "\n Chon Block :")))))))
(Alert (strcat "\nQuet chon LINE, POLYLINE: "))
(setq ss (ssget '((0 . "*POLYLINE,LINE"))))
(setq Lts_EnameLine (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "LINE") x nil)) (acet-ss-to-list ss))))
(setq Lts_EnamePLine (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "LWPOLYLINE") x nil)) (acet-ss-to-list ss))))
(setq Lt1 (ConverLine2Point Lts_EnameLine))
(setq Lt2 (ConverPline2Point Lts_EnamePLine))
(setq Lts (append Lt1 Lt2))
(setq LtsFilter (TD:Remove-Point-duplicates Lts))
(mapcar '(lambda (x) (MakeInsert TenBlock x 1 0)) LtsFilter)
(princ)
)


(defun ConverLine2Point (Lts_EnameLine / EnameLine )
(setq L2 (list))
(foreach EnameLine Lts_EnameLine
  	(setq L2 (append L2 (list (cdr (assoc 10 (entget  EnameLine))) (cdr (assoc 11 (entget  EnameLine))))))
)
L2
)


(defun ConverPline2Point (Lts_EnamePLine / Dsdinh EnamePLine )
(setq L3 (list))
(foreach EnamePLine Lts_EnamePLine
        (setq L3 (append L3 (acet-geom-vertex-list EnamePLine)))
)
L3
)



(defun LM:_UniqueFuzz ( l fz )
    (if l
      (cons (car l)
        (LM:_UniqueFuzz
          (vl-remove-if '(lambda ( x ) (equal x (car l)  fz)) (cdr l)) fz
        )
      )
    )
)


(defun LM:RemoveOnce ( l1 l2 )
  (if l1
    (if (equal (car l1) l2)
      (LM:RemoveOnce (cdr l1) l2)
      (cons (car l1) (LM:RemoveOnce (cdr l1) l2))
    )
  )
)

(defun TD:Remove-Point-duplicates (ss_list /  Lts1 Lts2 )
(vl-load-com)
(setq Lts1  (LM:_UniqueFuzz ss_list 0.00000001))
(setq Lts3 (LM:RemoveOnce Lts1 ss_list))
Lts3
)


(defun MakeInsert (Blkname inspoint scale ang / lst obj i)
(setq lst '()
      i -1
      en (cdr (last (tblsearch "block" Blkname)))
      obj (entget en)
)
(entmakex  (list
	  	'(0 . "INSERT")
		'(100 . "AcDbEntity")
		'(100 . "AcDbBlockReference")
		(cons 2 Blkname)
		(cons 10 (trans inspoint 1 0))
		(cons 41 scale)(cons 42 scale)(cons 43 scale)
		(cons 50 Ang)
)
)
)

hi hi, của bạn đây ^^

(defun c:TTL (/ old lmax lmin ename1 ename2 info1 sl info2 dai1 dai2 ltb ldelta e1 e2) ;
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai be nhat:")
(setq lmin (ssget "+.:E:S" '((0 . "LINE"))))
(if lmin
 (progn
    (setq ename1 (ssname lmin 0)
	      info1 (entget ename1)
		  dai1 (distof (rtos (distance (cdr (assoc 10 info1)) (cdr (assoc 11 info1))) 2 3))
	 )
  )
)  
...
>>

hi hi, của bạn đây ^^

(defun c:TTL (/ old lmax lmin ename1 ename2 info1 sl info2 dai1 dai2 ltb ldelta e1 e2) ;
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai be nhat:")
(setq lmin (ssget "+.:E:S" '((0 . "LINE"))))
(if lmin
 (progn
    (setq ename1 (ssname lmin 0)
	      info1 (entget ename1)
		  dai1 (distof (rtos (distance (cdr (assoc 10 info1)) (cdr (assoc 11 info1))) 2 3))
	 )
  )
)  
 ;=========================================================
(prompt "Chon thanh co chieu dai lon nhat:")
(setq lmax (ssget "+.:E:S" '((0 . "LINE"))))
(if lmax
 (progn
    (setq ename2 (ssname lmax 0)
	      info2 (entget ename2)
		  dai2  (distof (rtos (distance (cdr (assoc 10 info2)) (cdr (assoc 11 info2))) 2 3))
	 )
  )
)  
;===========================================================
(setq sl (getint "\nSo luong thanh mun tinh:"))
(setq ltb (distof (rtos (/ (+ dai1 dai2) 2.0) 2 3)))
(if (= (- ltb (fix ltb)) 0.5)
(setq ltb (+ ltb 0.5))
ltb
)
(setq ldelta (* (/ (- dai2 dai1) (- sl 1)) 1000))
;==============================================================
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e1)) "TEXT")
(prompt "Ban chon ko phai la text, ban chon lai hen!!!")
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(princ "\n")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(entmod (subst (cons 1 (strcat (itoa sl) "`14, L=" (rtos (* ltb 1000) 2 0))) (assoc 1 e1) e1))
;===============================================================
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e2)) "DIMENSION")
(prompt "doi tuong ban chon ko phai la dim, ban chon lai hen!!!")
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(princ "\n")
)
(entmod (subst (cons 1 (strcat (rtos (* dai1 1000) 2 0) "~" (rtos (* dai2 1000) 2 0) ", \U+0394L=" (rtos ldelta 2 0))) (assoc 1 e2) e2))
;======================================================================
(setvar "osmode" old)
(princ "\n")
(princ)
)
;===============================chon thanh co chieu dai ko doi edit vao text co san
(defun c:ttk(/ lx ename3 info3 dai3 e3 old sl dk)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai khong doi:")
(setq lx (ssget "+.:E:S" '((0 . "LINE"))))
(if lx
 (progn
    (setq ename3 (ssname lx 0)
	      info3 (entget ename3)
		  dai3 (distof (rtos (distance (cdr (assoc 10 info3)) (cdr (assoc 11 info3))) 2 3))
	 )
  )
)
(setq sl (getint "\nSo luong thanh mun tinh:"))
(setq dk (getint "\nNhap duong kinh Thep:"))
;====================================================
 (setq e3 (entget (car (entsel "\nchon text ghi ket qua L khong doi:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e3)) "TEXT")
(prompt "Ban chon ko phai la text, ban chon lai hen!!!")
(setq e3 (entget (car (entsel "\nchon text ghi ket qua L khong doi:"))))
(princ "\n")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(entmod (subst (cons 1 (strcat (itoa sl) "`" (itoa dk) ", L=" (rtos (* dai3 1000) 2 0))) (assoc 1 e3) e3))
(setvar "osmode" old)
(princ "\n")
(princ)
)

- nhoc đã sửa lại rùi, nhoc nghĩ cái đường kính bạn nhập là số ^^, giờ chuyển lại thành dạng text, khi lsp hỏi nhập đường kính thì bạn nhập sao cũng đc

- Vd: nhap duong kinh thep:`14 hay ~14 đều đc, dạng dữ liệu nhập là dạng chuỗi thì bạn nhập gì cũng đc, dài thòng lòng cũng đc ^^

(defun c:TTL (/ old lmax lmin ename1 ename2 info1 sl info2 dai1 dai2 ltb ldelta e1 e2)...
>>

- nhoc đã sửa lại rùi, nhoc nghĩ cái đường kính bạn nhập là số ^^, giờ chuyển lại thành dạng text, khi lsp hỏi nhập đường kính thì bạn nhập sao cũng đc

- Vd: nhap duong kinh thep:`14 hay ~14 đều đc, dạng dữ liệu nhập là dạng chuỗi thì bạn nhập gì cũng đc, dài thòng lòng cũng đc ^^

(defun c:TTL (/ old lmax lmin ename1 ename2 info1 sl info2 dai1 dai2 ltb ldelta e1 e2) ;
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai be nhat:")
(setq lmin (ssget "+.:E:S" '((0 . "LINE"))))
(if lmin
 (progn
    (setq ename1 (ssname lmin 0)
	      info1 (entget ename1)
		  dai1 (distof (rtos (distance (cdr (assoc 10 info1)) (cdr (assoc 11 info1))) 2 3))
	 )
  )
)  
 ;=========================================================
(prompt "Chon thanh co chieu dai lon nhat:")
(setq lmax (ssget "+.:E:S" '((0 . "LINE"))))
(if lmax
 (progn
    (setq ename2 (ssname lmax 0)
	      info2 (entget ename2)
		  dai2  (distof (rtos (distance (cdr (assoc 10 info2)) (cdr (assoc 11 info2))) 2 3))
	 )
  )
)  
;===========================================================
(setq sl (getint "\nSo luong thanh mun tinh:"))
(setq ltb (distof (rtos (/ (+ dai1 dai2) 2.0) 2 3)))
(if (= (- ltb (fix ltb)) 0.5)
(setq ltb (+ ltb 0.5))
ltb
)
(setq ldelta (* (/ (- dai2 dai1) (- sl 1)) 1000))
;==============================================================
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e1)) "TEXT")
(prompt "Ban chon ko phai la text, ban chon lai hen!!!")
(setq e1 (entget (car (entsel "\nchon text ghi ket qua L trung binh:"))))
(princ "\n")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(entmod (subst (cons 1 (strcat (itoa sl) "`14, L=" (rtos (* ltb 1000) 2 0))) (assoc 1 e1) e1))
;===============================================================
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e2)) "DIMENSION")
(prompt "doi tuong ban chon ko phai la dim, ban chon lai hen!!!")
(setq e2 (entget (car (entsel "\nchon dim ghi ket qua L delta:"))))
(princ "\n")
)
(entmod (subst (cons 1 (strcat (rtos (* dai1 1000) 2 0) "~" (rtos (* dai2 1000) 2 0) ", \U+0394L=" (rtos ldelta 2 0))) (assoc 1 e2) e2))
;======================================================================
(setvar "osmode" old)
(princ "\n")
(princ)
)
;===============================chon thanh co chieu dai ko doi edit vao text co san
(defun c:ttk(/ lx ename3 info3 dai3 e3 old sl dk)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(prompt "Chon thanh co chieu dai khong doi:")
(setq lx (ssget "+.:E:S" '((0 . "LINE"))))
(if lx
 (progn
    (setq ename3 (ssname lx 0)
	      info3 (entget ename3)
		  dai3 (distof (rtos (distance (cdr (assoc 10 info3)) (cdr (assoc 11 info3))) 2 3))
	 )
  )
)
(setq sl (getint "\nSo luong thanh mun tinh:"))
(setq dk (getstring "\nNhap duong kinh Thep:"))
;====================================================
 (setq e3 (entget (car (entsel "\nchon text ghi ket qua L khong doi:"))))
(princ "\n")
(while (/= (cdr (assoc 0 e3)) "TEXT")
(prompt "Ban chon ko phai la text, ban chon lai hen!!!")
(setq e3 (entget (car (entsel "\nchon text ghi ket qua L khong doi:"))))
(princ "\n")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(entmod (subst (cons 1 (strcat (itoa sl) dk ", L=" (rtos (* dai3 1000) 2 0))) (assoc 1 e3) e3))
(setvar "osmode" old)
(princ "\n")
(princ)
)

P/s: nhoc đã test rùi ok, ko có lỗi gì hết, có thể là lúc chọn text để thay đổi bạn chưa chọn gì hết nhấn enter lun hay nhấn chuột phải lun nên nó báo lỗi