- ok nhoc đã sữa lại lệnh ttk, có thể chọn line or pline đều đc ^^

(vl-load-com)
;==================
(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...
>>

- ok nhoc đã sữa lại lệnh ttk, có thể chọn line or pline đều đc ^^

(vl-load-com)
;==================
(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 dai3 0.0)
	 (while (setq ename3 (ssname lx 0))
           (setq dai3 (+ dai3 (Length1 ename3)))
		   (ssdel ename3 lx))
	     (setq dai3 (distof (rtos dai3 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)
)
;=============================================
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;=========================================================

Rảnh tí nên nắn nót lại cái này cho Hoằn:

- Lisp VE: chỉ vẽ, không Group thành từng nhóm

- Lisp TKO, TKO: thống kê thằng nào thì "bọn chúng" vào 1 group

- Có thể undo, và bẫy một vài lỗi có thể ...(lisp VE)

;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)
;ham bay loi
(setq temperr...
>>

Rảnh tí nên nắn nót lại cái này cho Hoằn:

- Lisp VE: chỉ vẽ, không Group thành từng nhóm

- Lisp TKO, TKO: thống kê thằng nào thì "bọn chúng" vào 1 group

- Có thể undo, và bẫy một vài lỗi có thể ...(lisp VE)

;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)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (mapcar 'setvar lst_va old)
	(cond
		((tblsearch "ucs" "save_ucs") 
			(command "ucs" "na" "r" "save_ucs")
			(command "ucs" "na" "d" "save_ucs")
			)
	)
	(cond
		((tblsearch "ucs" "save1_ucs") 
			(command "ucs" "na" "r" "save1_ucs")
			(command "ucs" "na" "d" "save1_ucs")
			)
	)
    (setq *error* temperr)
	(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(command ".undo" "be")
;=================
(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 ! *****")
)
(command ".undo" "end")
(setq *error* temperr)	;tra ham erorr nguyen thuy
(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 thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss lst tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
;(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))
	  lst (ss2lst ss)
	  tong 0)
(foreach elem lst
	(command ".area" "o" elem)
	(setq S (getvar 'area)
		  L (/ (- S (* 2 pi 0.25 D D)) (* pi D))
		  tong (+ L tong))
)	;for
(command "group" "c" (strcat "Ong_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_ong" ss "")
(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)
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
(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)))
(command "group" "c" (strcat "Cut_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_cut" ss "")
(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)
)

Tranh thủ luyện tí ! :D

 

p/s:

Thanh thép phải là LINE hoặc PLINE được vẽ bằng layer "THEP" , nếu tên layer của bạn chưa đúng thì sửa lisp lại ^^

 

Layer và màu có lẻ là bạn chưa ưng ý, mình sẽ sửa khi bạn cho xem bản vẽ mẫu !

 

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old ss pt1 pt2 ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	 ...
>>

Tranh thủ luyện tí ! :D

 

p/s:

Thanh thép phải là LINE hoặc PLINE được vẽ bằng layer "THEP" , nếu tên layer của bạn chưa đúng thì sửa lisp lại ^^

 

Layer và màu có lẻ là bạn chưa ưng ý, mình sẽ sửa khi bạn cho xem bản vẽ mẫu !

 

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old ss pt1 pt2 ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(cond ((not(tblsearch "block" "mui_ten"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten" '(0 0 0) (entlast) "")
			))
;=================
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE") (8 . "THEP")))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(if (and ss pt1 pt2)
	(progn
		(MAKELINE pt1 pt2 nil nil "DONG" nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 1)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten" "S" 1 "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** NOTE: Cac thanh thep phai duoc ve bang layer <THEP> ***")
)	;if
(mapcar 'setvar lst_va old)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(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)
)

Sưu tầm và chắp vá giúp bạn.
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/70261-nho-viet-lisp-gan-cao-do-cho-duong-dong-muc-va-ghi-ra-text/
;GAN CAO DO CHO DUONG DONG MUC VA GHI RA TEXT
;=======KANGKUNG 14/04/2013 - REV1===========
(defun C:kk( / i index pt pt1 pt2 taphop lst...

Sưu tầm và chắp vá giúp bạn.
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/70261-nho-viet-lisp-gan-cao-do-cho-duong-dong-muc-va-ghi-ra-text/
;GAN CAO DO CHO DUONG DONG MUC VA GHI RA TEXT
;=======KANGKUNG 14/04/2013 - REV1===========
(defun C:kk( / i index pt pt1 pt2 taphop lst huong)
(setvar "CMDECHO" 0)
(setvar "DIMZIN" 0)
(command "UNDO" "BE")
(setq os(getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq taphop (ssget '((0 . "POLYLINE,LWPOLYLINE")))) ;POLYLINE,LWPOLYLINE
(if (and (/= docao nil) (= (length list_caodo) 2))
(setq docao (read (lisped (rtos (+ (- (nth 1 list_caodo) (nth 0 list_caodo)) docao) 2 2))))
(if (/= docao nil)
(setq docao (read (lisped (rtos docao 2 2))))
(setq docao (read (lisped "Nhap do cao duong dong muc vao day")))
)
)
(if (< (length list_caodo) 2)
(setq list_caodo(append list_caodo (list docao)))
(setq list_caodo(append (list (nth 1 list_caodo)) (list docao)))
)
(if (= Height nil)
(setq Height(read(lisped "Nhap cao chu vao day")))
)
(setq index 0)
(while (< index (sslength taphop))
(vla-put-elevation (vlax-ename->vla-object (ssname taphop index)) docao)
(vla-put-color (vlax-ename->vla-object (ssname taphop index)) 2)
(setq index (1+ index))
)
(while (setq pt (getpoint "\n Pick diem chen TEXT: " ))
(huongtext)
(entmake (list '(0 . "TEXT") (cons 10 pt2) (cons 40 Height) (cons 1 (rtos docao 2 0)) (cons 50 huong)))(txt2mtxt)
)
(setvar "OSMODE" os)
(command "UNDO" "END")
(setvar "cmdecho" 1)
(princ)
)
(defun huongtext()
(setq i 0)
(setq lst(list))
(while (< i (sslength taphop))
(setq dt(ssname taphop i))
(setq pt1(vlax-curve-getClosestPointTo dt pt))
(if (and (<= pi (angle pt1 pt)) (<= (angle pt1 pt) (* 2 pi)))
(setq pt2(polar pt1 (angle pt pt1) (/ Height -2)))
(setq pt2(polar pt1 (angle pt1 pt) (/ Height -2)))
)
(if (= (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) (vla-get-length (vlax-ename->vla-object dt)))
(setq huong(angle ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) -0.001)) (vlax-curve-getClosestPointTo dt pt) ))
(setq huong(angle (vlax-curve-getClosestPointTo dt pt) ( vlax-curve-getPointAtDist dt (+ (vlax-curve-getDistAtPoint dt (vlax-curve-getClosestPointTo dt pt)) 0.001))))
)
(if (and (> huong (/ pi 2)) (< huong (/ (* 3 pi) 2))) (setq huong(- huong pi)))
(setq lst(append lst (list (list (distance pt pt1) huong pt2))))
(setq i(1+ i))
)
(setq lst(vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2)))))
(setq huong(cadr(nth 0 lst)))
(setq pt2(caddr(nth 0 lst)))
)
(princ "\n KangKung - 14/04/2013\n")
(princ "\n Nhap KK de chay chuong trinh\n")

(defun txt2mtxt (/ sset count num en el
mcontent bbox point1 point2 point3 point4
mwidth mheight mstyle njust mrotate nmtext ss)
(if (setq sset (ssget "L"))
(progn
(setq count 0
ss (ssadd)
) ;_ end of setq
(while (ssname sset COUNT)
(setq EN (ssname sset COUNT))
(setq EL (entget EN))
(if (= (cdr (assoc 0 EL)) "TEXT")
(progn
(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
(setq EL (subst mcontent(assoc 1 EL) EL))
(setq bbox (acet-geom-textbox EL 0.1))
(setq point1 (car bbox))
(setq point2 (cadr bbox))
(setq point3 (cadr (cdr bbox)))
(setq point4 (cadr (cdr (cdr bbox))))
(setq mwidth (cons '41 (distance point1 point2)))
(setq mheight (cons '40 (cdr (assoc 40 el))))
(setq mstyle (cons '7 (cdr (assoc 7 el))))
(setq nspace (cons '410 (cdr (assoc 410 EL))))
(setq minsert (cons '10 (cdr (assoc 10 EL))))
(cond
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 1))
) ;JY
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 2))
) ;JU
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 3))
(setq NJUST (cons '71 3))
) ;JI
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 2))
(setq NJUST (cons '71 6))
) ;JK
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 4) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 8))
) ;JM
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 1))
(setq NJUST (cons '71 9))
) ;J,
((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 0))
(setq NJUST (cons '71 7))
) ;JN
) ;_ end of cond
(setq mrotate (cons '50 (cdr (assoc 50 el))))
(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity")
'(67 . 0) nspace
'(8 . "TEXT") '(100 . "AcDbMText")
minsert njust
mheight mwidth
mstyle mcontent
mrotate
) ;_ end of list
) ;_ end of setq
(vla-put-backgroundfill
(vlax-ename->vla-object (entmakex nmtext))
:vlax-true
) ;_ end of vla-put-BackgroundFill
(ssadd (entlast) ss)
(entdel en)
(setq count (+ count 1))
) ;_ end of progn
(setq count (+ count 1))
) ;_ end of if
) ;_ end of while
(if (> (sslength ss) 0)
(command "_draworder" ss "" "_F")
) ;_ end of if
)
)
(princ)
) ;_ end of defun
(vl-load-com)

Bạn dùng cái này thử xem.

Chọn 1 khung pline rồi chọn cái tên khung (ô-..), chọn tới đâu xuất excel tới đó.

Phần diện tích k biết lấy đơn vị là gì.

(defun c:tta (/ 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
                     ...
>>

Bạn dùng cái này thử xem.

Chọn 1 khung pline rồi chọn cái tên khung (ô-..), chọn tới đâu xuất excel tới đó.

Phần diện tích k biết lấy đơn vị là gì.

(defun c:tta (/ 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)
 
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "TEXT"))))))
sst (vl-remove-if-not '(lambda (x) (distof (vla-get-TextString (vlax-ename->vla-object x)))) ss)
sst (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint)
 (vla-get-TextString (vlax-ename->vla-object x)))) sst)
  )
  (prompt "\nChon khung pline:")
  (while (setq pl (ssget ":E:S" '((0 . "LWPOLYLINE"))))
    (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
    (setq pl (ssname pl 0)) (redraw pl 3)
    (setq oo (car (entsel "\nChon ten cua khung:")))  (redraw pl 4) (redraw oo 3)
    
    (setq  ssd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl))) 
 lst (list (vla-get-TextString (vlax-ename->vla-object oo)))
    )
    (foreach pt ssd
      (setq txt (car (vl-sort sst '(lambda (x y) (< (distance (car x) pt) (distance (car y) pt)))))
   lst (append lst (list (last txt))) 
      )
    )
    (setq lst (append lst (list (vla-get-Area (vlax-ename->vla-object pl))))
 i -1 row (1+ row))
    (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) lst)
    (prompt "\nChon khung pline:")
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
  (redraw)
  (princ)
)

@cdhn:

- File cụ thể của bạn vẫn chưa đc cụ thể lắm :D vì nó vẫn chưacó "đường chỉ"

Tuy nhiên, mình xử lý tạm vậy >>> coi như xong.

 

- Về phần thanh thép có trường hợp là bock >>> phiền bạn explode trước khi chạy lisp (có thể quản lý đồi tượng bằng Group hoặc array)

 

- Độ lớn mũi tên, mình chỉnh vừa (tạm coi được) với bản vẽ...

@cdhn:

- File cụ thể của bạn vẫn chưa đc cụ thể lắm :D vì nó vẫn chưacó "đường chỉ"

Tuy nhiên, mình xử lý tạm vậy >>> coi như xong.

 

- Về phần thanh thép có trường hợp là bock >>> phiền bạn explode trước khi chạy lisp (có thể quản lý đồi tượng bằng Group hoặc array)

 

- Độ lớn mũi tên, mình chỉnh vừa (tạm coi được) với bản vẽ bạn gửi lên (do ko có mẫu)

>>> nếu ko vừa ý bạn có thể chỉnh trong dòng

(command "-insert" "mui_ten_hiep" "S" 20 "R" (angle pt1 pt2) pt)

thay số 20 bằng số hợp lý !

 

@Nhóc:

- "Điểm góc" trong lisp là nơi đặt text ghi chú, Nhóc pick ra ngoài >>> "sẽ có râu" , OK !

 

- Mũi tên = block là theo trường phái của cad >>> mình bảo lưu.

 

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old pt1 pt2 ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(if (not(tblsearch "layer" "DONG_MAU_DO")) (MakeLayer "DONG_MAU_DO" 1 nil nil T))
(setq lay (getvar 'clayer))
(setvar 'clayer "DONG_MAU_DO")
;=================
(cond ((not(tblsearch "block" "mui_ten_hiep"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten_hiep" '(0 0 0) (entlast) "")
			))
;=================
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget '((0 . "LINE,LWPOLYLINE")))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(if (and ss pt1 pt2)
	(progn
		(MAKELINE pt1 pt2 nil nil nil nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 1)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten_hiep" "S" 20 "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** Dau vao chu hop ly ***")
)	;if
(mapcar 'setvar lst_va old)
(setvar 'clayer lay)
(princ)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(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)
)
;================================
(defun MakeLayer (name color linetype lineWeight plot)	
(entmakex (list '(0 . "LAYER")								 
				(cons 100 "AcDbSymbolTableRecord")								 
				(cons 100 "AcDbLayerTableRecord")								 
				(cons 2 name)								 
				(cons 70 0)								 
				(cons 62 (if color color 7))								 
				(cons 6 (if linetype linetype "Continuous"))								 
				(cons 290 (if plot 1 0))								 
				(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))))
)

Đã chỉnh sửa theo ý bạn

Song, như vậy là nếu thép nằm ở nhiều layer thì phải ghi nhiều lần, OK !

Cad 2015 mình ko cài nên ko biết, mình 2014 chạy rầm rầm :D :D :D

>>> Đây bạn:

 

P/s: Đã chỉnh sửa (khai thêm biến cục bộ cho đủ) lúc 16h26 ngày 21/10/2014_Nếu cdhn đã lỡ down thì down lại, tranh sai sót đáng tiếc !!!

;lisp ve mui ten ghi chu...
>>

Đã chỉnh sửa theo ý bạn

Song, như vậy là nếu thép nằm ở nhiều layer thì phải ghi nhiều lần, OK !

Cad 2015 mình ko cài nên ko biết, mình 2014 chạy rầm rầm :D :D :D

>>> Đây bạn:

 

P/s: Đã chỉnh sửa (khai thêm biến cục bộ cho đủ) lúc 16h26 ngày 21/10/2014_Nếu cdhn đã lỡ down thì down lại, tranh sai sót đáng tiếc !!!

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old lay lay_thep ss pt1 pt2 ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(if (not(tblsearch "layer" "DONG_MAU_DO")) (MakeLayer "DONG_MAU_DO" 1 nil nil T))
(setq lay (getvar 'clayer))
(setvar 'clayer "DONG_MAU_DO")
;=================
(cond ((not(tblsearch "block" "mui_ten_hiep"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten_hiep" '(0 0 0) (entlast) "")
			))
;=================
(setq lay_thep (assoc 8 (entget (car (entsel "\nChon thanh thep mau: ")))))
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget (append '((0 . "LINE,LWPOLYLINE")) (list lay_thep)))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(if (and ss pt1 pt2)
	(progn
		(MAKELINE pt1 pt2 nil nil nil nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 1)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten_hiep" "S" 20 "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** Dau vao chu hop ly ***")
)	;if
(mapcar 'setvar lst_va old)
(setvar 'clayer lay)
(princ)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(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)
)
;================================
(defun MakeLayer (name color linetype lineWeight plot)	
(entmakex (list '(0 . "LAYER")								 
				(cons 100 "AcDbSymbolTableRecord")								 
				(cons 100 "AcDbLayerTableRecord")								 
				(cons 2 name)								 
				(cons 70 0)								 
				(cons 62 (if color color 7))								 
				(cons 6 (if linetype linetype "Continuous"))								 
				(cons 290 (if plot 1 0))								 
				(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))))
)

-^^ nói đến chuyên môn thì nhoc còn phải mót nhiều, do hoàn cảnh, tính chất công việc hiện tai của nhoc , mỗi người 1 hoàn cảnh 1 lời khó mà nói hết a ah, chủ yếu là vì nhoc thích tìm tòi ^^, mỗi lần viết thấy vui, tương lai thế nào chưa rõ, cố đc đến đâu hay đến đó.

- Clip anh nhoc xem trước đó rùi ^^, cách biên tập của a nó không giống bên nhoc, bên nhoc nhoc cũng có vài công trình...

-^^ nói đến chuyên môn thì nhoc còn phải mót nhiều, do hoàn cảnh, tính chất công việc hiện tai của nhoc , mỗi người 1 hoàn cảnh 1 lời khó mà nói hết a ah, chủ yếu là vì nhoc thích tìm tòi ^^, mỗi lần viết thấy vui, tương lai thế nào chưa rõ, cố đc đến đâu hay đến đó.

- Clip anh nhoc xem trước đó rùi ^^, cách biên tập của a nó không giống bên nhoc, bên nhoc nhoc cũng có vài công trình dạng tuyến chỉ rãi lưới đơn giản khổ giấy lớn hơn

- mục đích nhoc thử làm lsp này để hỗ trợ cho chương trình sẵn của cơ quan, nhưng có nhiều khi mình mún xử lý độc lập, còn chương trình nó hay ràng buộc theo nhiều cái khác khó xử lý tính huống nhanh^^

- nhoc ko giỏi hơn anh đâu ^^, nhoc chậm tiu lắm, chỉ cố gắng hết theo sức mình có

- nhoc có xem qua lsp tạo lưới của a, nhưng nó còn hơi cao với nhoc, nhìn lsp của nhoc đơn giản thui, nhưng mất đến 2 ngày nhoc mới làm xong kaka

;hàm tao textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(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 dtr (a)
(* (/ a 180.0) pi)
)
(prompt "LISP TAO LUOI TOA DO BAN DO VI TRI, LENH : KKL")
;;;
(defun c:kkl (/ donvi nx ny pt1 pt2 pt3 pt4 kcx kcy goc1 goc2 x1 x y  heso old ptext1 ptext2 ptext3 ptext4 str str2 goc3 htext num )
(vl-load-com)
(setq old (getvar "osmode"))
(if (null (tblsearch "STYLE" "vusaln"))
    (emk_style "vusaln" "Vaptimn.TTF"))
(if (null (tblsearch "LAYER" "A1-luoik"))
    (_layer2 "A1-luoik" 7))
  (setq donvi (list (cons 1  100) (cons 2  50) (cons 3  25)))
  (setq tyleVT (getvalue tyleVT 1000.0 "Nhap ty le ban do VT: "))
  (setq heso (/ 1000 tyleVT))
  (setq htext (/ 2.0 heso))
;===================================*******************++++++++++++++++++++********************===================================  
(while (and (setvar "osmode" 1)
            (setq pt1 (getpoint "\nChon diem goc duoi trai khung:"))
            (setq pt2 (getpoint pt1 "\nChon diem goc tren phai khung:")))
(progn
(setvar "osmode" 0)
;======================================================================
;=======================================================================
(setq pt3 (inters pt1 (polar pt1 (/ pi 2) 90000) pt2 (polar pt2 pi 90000) nil))
(setq pt4 (inters pt1 (polar pt1 0 90000) pt2 (polar pt2 (dtr 270) 90000) nil))
(setq kcx (distance pt1 pt4) kcy (distance pt1 pt3))
;==============================================================================
(cond 
((and (>= (/ kcx 100) 2) (>= (/ kcy 100) 2))
;==========================================================
(setq nx (fix (/ kcx 100)) ny (fix (/ kcy 100)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 1 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 1 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 1 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 1 donvi))))
  )
;============================================================
) ;end 100


;========================================================++++++++++**************+++++++++=======================================================
((and (>= (/ kcx 50) 2) (>= (/ kcy 50) 2))
;==========================================================
(setq nx (fix (/ kcx 50)) ny (fix (/ kcy 50)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 2 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 2 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 2 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 2 donvi))))
  )
;============================================================
) ;end 50
;============================================================******++++++++++++++++++++****************++++++++++++++++++++========================
((and (>= (/ kcx 25) 2) (>= (/ kcy 25) 2))
;==========================================================
(setq nx (fix (/ kcx 25)) ny (fix (/ kcy 25)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 3 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 3 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 3 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 3 donvi))))
  )
;============================================================
) ;end  25
;==================================================*********************++++++++++++++++++++*************===========================
((and (< (/ kcx 25) 2) (< (/ kcy 25) 2))
(alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^")) ; end nho hon 25
) ;end cond
;==================================================================++++++++++**************+++++++++=======================================
) ;end progn of while pt1 pt2
) ; end  while
(setvar "osmode" old)
(princ)
)
;==============================================================================================
;;;;;;;;;;;;;;;;;;;;
(defun lamtron (n / sodu)
  (setq sodu (rem n 100))
  (if (/= sodu 0)
    (setq n (+ (- n sodu) 100))
  )
  n
)
;=================================
(defun vediem (xx yy r / left right top bot)
  (setq top (+ yy r))
  (setq bot (- yy r))
  (setq right (+ xx r))
  (setq left (- xx r))
  (makeline (list left yy) (list right yy) "A1-luoik" nil nil nil)
  (makeline (list xx top) (list xx bot) "A1-luoik" nil nil nil)
)
;============================
;=================================================================================
(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)
            )
        )
    )
)
;=====================================================================================
;; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;;ham tao text 2
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 (if textstyle textstyle (getvar "textstyle")))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun them0(chuoi)
  (setq len (strlen chuoi))
  (if (= len 1)
    (strcat "00" chuoi)
    (if (= len 2)
      (strcat "0" chuoi)
      chuoi
    )  
  )
 ) 

Đây bạn:

 

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old lay lay_thep ss pt1 pt2 tl ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(if (not(tblsearch "layer" "DONG_MAU_DO")) (MakeLayer "DONG_MAU_DO" 1 nil nil T))
(setq lay (getvar 'clayer))
(setvar 'clayer "DONG_MAU_DO")
;=================
(cond ((not(tblsearch "block" "mui_ten_hiep"))
			(entmake (list
							'(0 ....
>>

Đây bạn:

 

;lisp ve mui ten ghi chu thep
(defun c:MT( / lst_va old lay lay_thep ss pt1 pt2 tl ent1 pt lst_pt)
(setq lst_va '("osmode" "cmdecho" "AUNITS")
	  old (mapcar 'getvar lst_va))
;=================
(if (not(tblsearch "layer" "DONG_MAU_DO")) (MakeLayer "DONG_MAU_DO" 1 nil nil T))
(setq lay (getvar 'clayer))
(setvar 'clayer "DONG_MAU_DO")
;=================
(cond ((not(tblsearch "block" "mui_ten_hiep"))
			(entmake (list
							'(0 . "TRACE")
							'(100 . "AcDbEntity") 
							;(cons 8 "0")
							'(100 . "AcDbTrace") 
							'(10 0 0 0) 
							'(11 0 0 0) 
							'(12 -2.5 -0.5 0) 
							'(13 -2.5 0.5 0)
							)
			)
			(command "-block" "mui_ten_hiep" '(0 0 0) (entlast) "")
			))
;=================
(setq lay_thep (assoc 8 (entget (car (entsel "\nChon thanh thep mau: ")))))
(prompt "\nChon cac thanh thep can ghi chu thich !")
(setq ss (ssget (append '((0 . "LINE,LWPOLYLINE")) (list lay_thep)))
	  pt1 (getpoint "\nXac dinh 2 diem tren duong dong ghi chu !\nChon diem goc: ")
	  pt2 (getpoint pt1 "\nChon diem phia ngon mui ten: ")
	  )
(mapcar 'setvar lst_va '(0 0 3))
(setq #tl# (NGT #tl# 1 getreal "Nhap ti le "))
(if (and ss pt1 pt2 tl)
	(progn
		(MAKELINE pt1 pt2 nil nil nil nil nil)	  
		(setq ent1 (entlast))
		(foreach elem (ss2lst ss)
			(setq lst1 (acet-geom-intersectwith ent1 elem 1)
				  pt (car (vl-sort lst1 '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
				  lst_pt (cons pt lst_pt))
			(command "-insert" "mui_ten_hiep" "S" (* 1.5 #tl#) "R" (angle pt1 pt2) pt)
			)	;for
		(setq lst_pt (vl-sort lst_pt '(lambda (x y) (> (distance pt1 x) (distance pt1 y)))))
		(entmod (subst (cons 11 (car lst_pt)) (assoc 11 (setq info (entget ent1))) info))
		)
	(princ "\n*** Dau vao chu hop ly ***")
)	;if
(mapcar 'setvar lst_va old)
(setvar 'clayer lay)
(princ)
)
;=================================
(defun MakeLine (PT1 PT2 Linetype LTScale Layer Color 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 62 (if Color Color 256))									
				(cons 10 PT1)	(cons 11 PT2)))
)
;===================================
(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)
)
;================================
(defun MakeLayer (name color linetype lineWeight plot)	
(entmakex (list '(0 . "LAYER")								 
				(cons 100 "AcDbSymbolTableRecord")								 
				(cons 100 "AcDbLayerTableRecord")								 
				(cons 2 name)								 
				(cons 70 0)								 
				(cons 62 (if color color 7))								 
				(cons 6 (if linetype linetype "Continuous"))								 
				(cons 290 (if plot 1 0))								 
				(cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))))
)
;=================================
(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)
	)
	)
)

Mình tiếp tục bài tập, mong Thầy Ket và các bạn hỗ trợ tiếp :

(defun C:dl(/ a B) ;Draw Line (5.1)
(setq os (getvar 'osmode)
echo (getvar 'cmdecho))
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(initget 1)
(setq a (getpoint "\nFirst point:"))
(initget 1)
(setq b (getpoint a "\nNext point:"))
(command "line" a...

Mình tiếp tục bài tập, mong Thầy Ket và các bạn hỗ trợ tiếp :

(defun C:dl(/ a B) ;Draw Line (5.1)
(setq os (getvar 'osmode)
echo (getvar 'cmdecho))
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(initget 1)
(setq a (getpoint "\nFirst point:"))
(initget 1)
(setq b (getpoint a "\nNext point:"))
(command "line" a B)
(setvar 'osmode os)
(setvar 'cmdecho echo)
(princ)
)

(defun ipos (n lst); ipos n list (5.2)
  (if (>  n 0)
  (nth (1- n) lst))
  )

 

Nhận xét : 2 bài bạn đều làm tốt.

Kết luận : Bỏ qua bài 3, tiếp tục các bài 4,5,6 bạn nhé

Lisp #11 này rất ok rồi. Nhờ các bác sửa giúp mình thêm tính năng chia các giá trị text theo các layer khác nhau ra các cột khác nhau và vẫn theo thứ tự như vậy.

Như trong file cad mình gửi thì có 3 layer. Mình vẫn thao tác như cũ, nhưng text thuộc layer nào thì xuất kqua ra cùng lúc 3 cột khác nhau cho 3 layer. Cách xuất thì vẫn y như lisp TTY vậy.

Nếu bác làm dc vậy thì bác làm giúp mình cả...

Lisp #11 này rất ok rồi. Nhờ các bác sửa giúp mình thêm tính năng chia các giá trị text theo các layer khác nhau ra các cột khác nhau và vẫn theo thứ tự như vậy.

Như trong file cad mình gửi thì có 3 layer. Mình vẫn thao tác như cũ, nhưng text thuộc layer nào thì xuất kqua ra cùng lúc 3 cột khác nhau cho 3 layer. Cách xuất thì vẫn y như lisp TTY vậy.

Nếu bác làm dc vậy thì bác làm giúp mình cả với trường hợp lisp TTX trên tại #6 kia nữa với nha. Thanks bác nhiều ạ ^^

http://www.cadviet.com/upfiles/3/64997_tty_new.dwg

 

 

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

- câu 4 nhoc nói theo cách hiểu nhoc có thể sai ^^, Vinh tham khảo

-  người dùng nhập vào thường có nhửng hàm nào, getint getreal, getstring, getdist, getangle,getorient, getcorner, getwordk, v....v

- Mong mún...

- câu 4 nhoc nói theo cách hiểu nhoc có thể sai ^^, Vinh tham khảo

-  người dùng nhập vào thường có nhửng hàm nào, getint getreal, getstring, getdist, getangle,getorient, getcorner, getwordk, v....v

- Mong mún của ta là viết 1 hàm con tổng quát cho các hàm trên, nếu Vinh có dạo vòng vòng lớp Vinh sẽ thấy các anh bàn luận về vấn đề này.

- anh Ket có gợi ý cho Vinh lsp bạn Hiep viết ở 1 topic khác có sử dụng hàm này, có thể lsp này còn phức tạp với Vinh nên Vinh ngại chưa dịch đc nó ^^, nhoc lôi nó ra cho Vinh thấy rõ

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

 

- đây là hàm con theo y/c bài 4 do bạn Hiệp viết, nhoc se phân tích khái quát cho Vinh hen

+ dòng 1 có lẽ Vinh hiểu NGT chỉ là tên hàm thui mún đặt sao cũng đc miễn mình biết công dụng nó làm gì

+ các tham số mà hàm cần 

     + a : đại diện tên biến mún đặt, vd như biến bán kính của vinh là gt thì khi gọi hàm NGT a <=> gt, làm từng bước gọi hàm ví dụ hen (NGT gt

     + mac_dinh: đây là giá trị mặc định mà ta mún gán cho biến gt là gì, mac_dinh <=> 10, (NGT gt 10

     + ham: đây là tên hàm nhập liệu của lsp mún sử dụng, 1 trong các hàm nhoc liệt kê trên kia, như ở đây bán kinh cho đường tròn có thể dùng getdist,real hay int cũng đc, như VInh làm thì ham <=> getdist, (NGT gt 10 getdist

     +str_nhac: ở đây như dòng nhắc vậy đó, srt_nhac <=> "moi ban nhap ban kinh", (NGT gt 10 getdist "moi ban nhap ban kinh") => xong phần gọi hàm ^^

- cách xài :

(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)
	)
	)
(defun c:tron(/ pt)
(setq gt (NGT gt 10 getdist "ban nhap ban kinh"))
(setq pt (getpoint "\ntam:"))
(command ".circle" pt gt)
)

- phần lõi nhoc nghĩ  Vinh dịch đc để hiểu mà hen, nhoc giải thik 2 chỗ mà trong hàm Vinh chưa pit, và ít ai để ý nếu lập trình chưa vững

1 - (vl-princ-to-string a),các hàm bắt đầu = vl mình chưa học tới , Hiep thì có thâm niên ở đây lâu nên học trước đc, màu đỏ là nguyên tên hàm, a ở đây chính là tên biến, hàm này có chức năng chuyển mọi dạng dữ liêu về kiểu chuỗi, số nguyên, số thực, giá trị góc bằng, danh sách,....Tại sao để khi chạy đến dòng nhập liệu ta biết nếu ko nhập gì giá trị mặc định nó là bao nhiêu như lệnh vẽ circle trong cad, vinh để ý sẽ thấy VD: ban nhap ban kinh (10):...., nếu ko nhập gì thì nó sẽ lấy là 10

2- tại sao có cặp dấu "", vì nếu gặp trường hợp dùng hàm getstring, ko nhập gì enter nó vẫn xem là có nhập vì chuỗi có thể rỗng

Hiep say: ^^

Ô la la !  :D  :D  :D

Là do Getstring trả về chuổi rỗng khi enter

- còn lại Vinh cứ từ từ ngâm cứu hen, còn 1 cái nhoc quên đó là thằng modul, đó là biến trung gian cục bộ trong hàm con nó sẽ tự khử, còn vì sao có nó, trong bài trước nhoc có giải thích sơ về việc tạo hàm con rồi hen.

- anh Doan Van Ha có nói:

Viết 1 hàm con nhập liệu để dùng cho mọi dạng Getxxx là 1 tham vọng khá lớn, bởi các hàm này có cách nhập khác nhau.Chúng còn có thể chứa thêm 1 tham số nữa ngoài các tham số mà bạn đã đưa vào. Ví dụ:

- Với Getstring: còn có tham số CR, mang giá trị T hoặc nil.

- Với các hàm Getdist, Getangle, Getorient, Getpoint, Getcorner: còn có tham số Pt.

p/S: viết lisp cũng tùy từng quan điểm. Với cá nhân thì tôi không chuộng kiểu này lắm.

- Tóm lại từ các ý trên Vinh có thể mông má lại theo quan điểm cũng như cách hiểu của mình

- như nhoc lợi thế đi sau ^^, tự rút ra cho mình cách viết riêng ^^ đông tây y kết hợp, phục vụ cho mục đích của mình mà mình có khả năng kiểm soát đc, nhoc viết như vậy

; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 2) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;

- vì sao nhoc viết tổng quát mà chỉ cho 3 thằng đó thì Vinh xem anh Ha nói ^^

- như nhoc viết thì lệnh vẽ đường trònh ví dụ trên sẽ là như vầy

(defun c:tron(/ pt)
(setq gt (getvalue gt 10.0 "ban nhap ban kinh"))
(setq pt (getpoint "\ntam:"))
)
; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;

- anh Ket cũng có nói thằng họ getxxx, có thể tóm đc thằng nào hay đó, của Hiep viết thì tổng quát hơn cho các thằng getxxx lun, nhoc cũng chưa thử sử dụng hàm của Hiep với trường hợp là getpoint hay getangle thì thế nào vì ngại ^^, nếu Vinh có thử thì cho nhoc pit k/q với hen ^^

Rảnh tí nên nắn nót lại cái này cho Hoằn:

- Lisp VE: chỉ vẽ, không Group thành từng nhóm

- Lisp TKO, TKO: thống kê thằng nào thì "bọn chúng" vào 1 group

- Có thể undo, và bẫy một vài lỗi có thể ...(lisp VE)

;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)
;ham bay loi
(setq temperr...
>>

Rảnh tí nên nắn nót lại cái này cho Hoằn:

- Lisp VE: chỉ vẽ, không Group thành từng nhóm

- Lisp TKO, TKO: thống kê thằng nào thì "bọn chúng" vào 1 group

- Có thể undo, và bẫy một vài lỗi có thể ...(lisp VE)

;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)
;ham bay loi
(setq temperr *error*)
(defun errorTrap (msg)
    (mapcar 'setvar lst_va old)
	(cond
		((tblsearch "ucs" "save_ucs") 
			(command "ucs" "na" "r" "save_ucs")
			(command "ucs" "na" "d" "save_ucs")
			)
	)
	(cond
		((tblsearch "ucs" "save1_ucs") 
			(command "ucs" "na" "r" "save1_ucs")
			(command "ucs" "na" "d" "save1_ucs")
			)
	)
    (setq *error* temperr)
	(princ "\n*** Da set lai bien, OK ! ***")
    (princ)
)
(setq *error* errorTrap)
;======het ham bay loi = P1 ============================
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(command ".undo" "be")
;=================
(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 ! *****")
)
(command ".undo" "end")
(setq *error* temperr)	;tra ham erorr nguyen thuy
(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 thong ke ong; cut trong he thong duong ong
(defun c:TKO( / lst_va old sam D ss lst tong L)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(17 0))
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
;(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))
	  lst (ss2lst ss)
	  tong 0)
(foreach elem lst
	(command ".area" "o" elem)
	(setq S (getvar 'area)
		  L (/ (- S (* 2 pi 0.25 D D)) (* pi D))
		  tong (+ L tong))
)	;for
(command "group" "c" (strcat "Ong_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_ong" ss "")
(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)
(or #lan_TK (setq #lan_TK 0))
(setq #lan_TK (1+ #lan_TK))
(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)))
(command "group" "c" (strcat "Cut_" (rtos (getvar 'cdate) 2 0) (itoa #lan_TK)) "Group_cut" ss "")
(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)
)

Quick code cho bạn 4 lisp o+, o-, mF, mC. Bạn test nếu thấy sai thì ấn F2 copy đoạn lỗi lên nhé. Mình chỉ kịp làm thế này thôi, phải đi rồi ^^

(vl-load-com)	
(defun ooo(f / ss isClosed)
(cond 
	(
		(ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
			(or #d (setq #d 5))
			(setq 	#d (cond ((getdist (strcat "\nDistance <" (rtos #d 2 2) ">")))(#d))
					isClosed 
					(lambda(x)
						(or  
							(and  (=...
>>

Quick code cho bạn 4 lisp o+, o-, mF, mC. Bạn test nếu thấy sai thì ấn F2 copy đoạn lỗi lên nhé. Mình chỉ kịp làm thế này thôi, phải đi rồi ^^

(vl-load-com)	
(defun ooo(f / ss isClosed)
(cond 
	(
		(ssget '((0 . "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")))
			(or #d (setq #d 5))
			(setq 	#d (cond ((getdist (strcat "\nDistance <" (rtos #d 2 2) ">")))(#d))
					isClosed 
					(lambda(x)
						(or  
							(and  (= (vla-get-ObjectName x) "AcDbEllipse")(zerop (vla-get-StartAngle x)))
							(= (vla-get-objectname x) "AcDbCircle")
							(and  	(wcmatch (vla-get-ObjectName x) "AcDb*line")
									(equal  (car (setq sth (acet-geom-vertex-list (vlax-vla-object->ename x))))
										(last sth)
										0.01
									)
							)
						)
					)
			)
			(vlax-for obj (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
				(if (isclosed obj)
					(vla-delete
						(f
						  (vl-sort
						   (mapcar 'car (list (vlax-invoke obj 'Offset #d)  (vlax-invoke obj 'Offset (- #d))))
						   '(lambda(x y)(< (vlax-get x 'Area)(vlax-get y 'Area)))
						  )
						)
					)
				 )
			)
			(vla-delete ss)
		)
		(T (princ "\nNo thing to do"))
)
)
(defun c:o-()(ooo last)) ;Offset thu nho
(defun c:o+()(ooo car))	;Offset phong to

(defun c:mF(/ ss);Multi Fillet
(cond ((setq ss (ssget '((0 . "LWPOLYLINE"))))
    (or #r (setq #r (getvar 'FILLETRAD)))
    (setq     #r (cond ((getdist (strcat "\nRadius : <" (rtos #r 2 2) ">")))(#r)))
    (setvar 'FILLETRAD #r)
    (foreach o (acet-ss-to-list ss)
        (vl-cmdf "._Fillet" "_Polyline" o)
    )
)))
(defun c:mC(/ ss);Multi chamfer
(cond ((setq ss (ssget '((0 . "LWPOLYLINE"))))
    (or #dis (setq #dis (getvar 'CHAMFERA)))
    (setq     #dis (cond ((getdist (strcat "\nDistance : <" (rtos #dis 2 2) ">")))(#dis)))
    (mapcar 'setvar '(CHAMFERA CHAMFERB) (list #dis #dis))
    (foreach o (acet-ss-to-list ss)
        (vl-cmdf "._Chamfer" "_Polyline" o)
    )
)))

Chào bạn 843824,
Bạn dùng thử cái này xem đúng ý chưa nhé. Nếu chưa thì hãy post lên để mình xem lại.
Trước khi dùng lisp, bạn phải tạo các text như bạn đã mô tả. Lisp sẽ tự động sắp xếp lại các text của bạn theo thứ tự tăng hay giảm dần của tọa độ x của điểm đặt text. Bạn sẽ phải lựa chon chiều đặt các text theo tọa độ x này khi lisp hỏi bằng các nhập vào bàn...

Chào bạn 843824,
Bạn dùng thử cái này xem đúng ý chưa nhé. Nếu chưa thì hãy post lên để mình xem lại.
Trước khi dùng lisp, bạn phải tạo các text như bạn đã mô tả. Lisp sẽ tự động sắp xếp lại các text của bạn theo thứ tự tăng hay giảm dần của tọa độ x của điểm đặt text. Bạn sẽ phải lựa chon chiều đặt các text theo tọa độ x này khi lisp hỏi bằng các nhập vào bàn phím các ký tự P hay T bạn nhé.
Lisp đây:

Mong rằng bạn sẽ hài lòng.

Bạn dùng cái này. Lúc chạy lần đầu nó có hỏi chọn layer, bạn pick 3 cái text để lấy 3 layer.

(vl-load-com)
(defun batdau ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                 ...
>>

Bạn dùng cái này. Lúc chạy lần đầu nó có hỏi chọn layer, bạn pick 3 cái text để lấy 3 layer.

(vl-load-com)
(defun batdau ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (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"))
   (vla-put-visible xlApp :vlax-true)
  
   (if (not tlayer1)
    (progn (alert "Hay chon Layer")
      (setq tlayer1 (dxf 8 (car (entsel "\nChon text thuoc layer 1:")))
 tlayer2 (dxf 8 (car (entsel "\nChon text thuoc layer 2:")))
 tlayer3 (dxf 8 (car (entsel "\nChon text thuoc layer 3:")))))
  )
  (setq row1 0 row2 0 row3 0)
  (setq col1 1 col2 5 col3 9)
)
 
(defun ghi (tlayer row col dau / ss1 ss0 y i iPt)
    (setq ss1 (vl-remove-if-not '(lambda (x) (= (dxf 8 x) tlayer)) ss)
 ss1 (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'InsertionPoint)
 (vlax-ename->vla-object x))) ss1)
 cao (vla-get-Height (last (car ss1))))
    (while ss1
(setq  ss1 (vl-sort ss1 '(lambda (x y) (dau (cadr (car x)) (cadr (car y)))))
      ss0 (vl-remove-if-not '(lambda (x) (equal (cadr (caar ss1)) (cadr (car x)) cao)) ss1)
      ss0 (vl-sort ss0 '(lambda (x y) (< (caar x) (caar y))))
      ss1 (vl-remove-if '(lambda (x) (member x ss0)) ss1)
)
(foreach z ss0
          (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))
 ) 
          (setq i -1 row (1+ row))
          (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) y)
)
      )
  row
)
 
(defun c:ttx  (/ ss ss1 y xlApp xlCells row col i iPt)
  (batdau) (prompt "\nChon text")
  (if (setq ss (ssget '((0 . "*TEXT"))))
    (progn
      (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq row1 (ghi tlayer1 row1 col1 <))
      (setq row2 (ghi tlayer2 row2 col2 <))
      (setq row3 (ghi tlayer3 row3 col3 <))      
    )
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (princ)
)
 
(defun c:tty (/ ss xlApp xlCells row1 row2 row3)
  (batdau) (prompt "\nChon text")
  (while (setq ss (ssget '((0 . "TEXT"))))
    (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    (setq row1 (ghi tlayer1 row1 col1 >))
    (setq row2 (ghi tlayer2 row2 col2 >))
    (setq row3 (ghi tlayer3 row3 col3 >))
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))  
  (princ)
)

 

@tientracdia : cái này chỉ đỡ hơn ở chỗ không cần chọn text mà chỉ cần chọn khung pline, nhưng không quét và sắp xếp theo thứ tự mà bạn phải pick từng cái thôi, thứ tự do bạn chọn.

(defun c:tta (/ ss sst ssc ssd pl oo txt xlApp xlCells row col i lst area)
  (vl-load-com)
  (defun inside(pt l)
    (defun tgoc(a b c) (abs (- pi (abs (- (angle b c) (angle a b))))))
    (equal 6.28319 (apply '+ (mapcar '(lambda(x y) (tgoc x pt y)) l (append (cdr l) (list (car l))))) 0.001)
  )
  (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)
 
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "TEXT"))))))
sst (vl-remove-if-not '(lambda (x) (distof (vla-get-TextString (vlax-ename->vla-object x)))) ss)
ssc (vl-remove-if '(lambda (x) (member x sst)) ss)
sst (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint)
 (vla-get-TextString (vlax-ename->vla-object x)))) sst) 
  )
  (prompt "\nChon khung pline:")
  (while (setq pl (ssget ":E:S" '((0 . "LWPOLYLINE"))))
    (setq pl (ssname pl 0)) (redraw pl 3)    
    (setq ssd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl)))
 oo (vl-remove-if-not '(lambda (x) (inside (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint) ssd)) ssc))
    (if oo
      (progn 
(setq oo (car oo)
     ssc (vl-remove oo ssc)
     lst (list (vla-get-TextString (vlax-ename->vla-object oo))))
        (foreach pt ssd
          (setq txt (car (vl-sort sst '(lambda (x y) (< (distance (car x) pt) (distance (car y) pt)))))
       lst (append lst (list (last txt))) 
          )
        )
        (setq area (rtos (* 0.000001 (vla-get-Area (vlax-ename->vla-object pl))) 2 2)
     i -1 row (1+ row))
        (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) lst)
        (vlax-put-property xlCells "Item" row 9 area)
       )
    )
    (prompt "\nChon khung pline:")
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
  (redraw)
  (princ)
)

Bạn dùng cái này. Lúc chạy lần đầu nó có hỏi chọn layer, bạn pick 3 cái text để lấy 3 layer.

(vl-load-com)
(defun batdau ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                 ...
>>

Bạn dùng cái này. Lúc chạy lần đầu nó có hỏi chọn layer, bạn pick 3 cái text để lấy 3 layer.

(vl-load-com)
(defun batdau ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (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"))
   (vla-put-visible xlApp :vlax-true)
  
   (if (not tlayer1)
    (progn (alert "Hay chon Layer")
      (setq tlayer1 (dxf 8 (car (entsel "\nChon text thuoc layer 1:")))
 tlayer2 (dxf 8 (car (entsel "\nChon text thuoc layer 2:")))
 tlayer3 (dxf 8 (car (entsel "\nChon text thuoc layer 3:")))))
  )
  (setq row1 0 row2 0 row3 0)
  (setq col1 1 col2 5 col3 9)
)
 
(defun ghi (tlayer row col dau / ss1 ss0 y i iPt)
    (setq ss1 (vl-remove-if-not '(lambda (x) (= (dxf 8 x) tlayer)) ss)
 ss1 (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'InsertionPoint)
 (vlax-ename->vla-object x))) ss1)
 cao (vla-get-Height (last (car ss1))))
    (while ss1
(setq  ss1 (vl-sort ss1 '(lambda (x y) (dau (cadr (car x)) (cadr (car y)))))
      ss0 (vl-remove-if-not '(lambda (x) (equal (cadr (caar ss1)) (cadr (car x)) cao)) ss1)
      ss0 (vl-sort ss0 '(lambda (x y) (< (caar x) (caar y))))
      ss1 (vl-remove-if '(lambda (x) (member x ss0)) ss1)
)
(foreach z ss0
          (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))
 ) 
          (setq i -1 row (1+ row))
          (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) y)
)
      )
  row
)
 
(defun c:ttx  (/ ss ss1 y xlApp xlCells row col i iPt)
  (batdau) (prompt "\nChon text")
  (if (setq ss (ssget '((0 . "*TEXT"))))
    (progn
      (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq row1 (ghi tlayer1 row1 col1 <))
      (setq row2 (ghi tlayer2 row2 col2 <))
      (setq row3 (ghi tlayer3 row3 col3 <))      
    )
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (princ)
)
 
(defun c:tty (/ ss xlApp xlCells row1 row2 row3)
  (batdau) (prompt "\nChon text")
  (while (setq ss (ssget '((0 . "TEXT"))))
    (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    (setq row1 (ghi tlayer1 row1 col1 >))
    (setq row2 (ghi tlayer2 row2 col2 >))
    (setq row3 (ghi tlayer3 row3 col3 >))
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))  
  (princ)
)

 

@tientracdia : cái này chỉ đỡ hơn ở chỗ không cần chọn text mà chỉ cần chọn khung pline, nhưng không quét và sắp xếp theo thứ tự mà bạn phải pick từng cái thôi, thứ tự do bạn chọn.

(defun c:tta (/ ss sst ssc ssd pl oo txt xlApp xlCells row col i lst area)
  (vl-load-com)
  (defun inside(pt l)
    (defun tgoc(a b c) (abs (- pi (abs (- (angle b c) (angle a b))))))
    (equal 6.28319 (apply '+ (mapcar '(lambda(x y) (tgoc x pt y)) l (append (cdr l) (list (car l))))) 0.001)
  )
  (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)
 
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "TEXT"))))))
sst (vl-remove-if-not '(lambda (x) (distof (vla-get-TextString (vlax-ename->vla-object x)))) ss)
ssc (vl-remove-if '(lambda (x) (member x sst)) ss)
sst (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint)
 (vla-get-TextString (vlax-ename->vla-object x)))) sst) 
  )
  (prompt "\nChon khung pline:")
  (while (setq pl (ssget ":E:S" '((0 . "LWPOLYLINE"))))
    (setq pl (ssname pl 0)) (redraw pl 3)    
    (setq ssd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl)))
 oo (vl-remove-if-not '(lambda (x) (inside (vlax-get (vlax-ename->vla-object x) 'TextAlignmentPoint) ssd)) ssc))
    (if oo
      (progn 
(setq oo (car oo)
     ssc (vl-remove oo ssc)
     lst (list (vla-get-TextString (vlax-ename->vla-object oo))))
        (foreach pt ssd
          (setq txt (car (vl-sort sst '(lambda (x y) (< (distance (car x) pt) (distance (car y) pt)))))
       lst (append lst (list (last txt))) 
          )
        )
        (setq area (rtos (* 0.000001 (vla-get-Area (vlax-ename->vla-object pl))) 2 2)
     i -1 row (1+ row))
        (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) lst)
        (vlax-put-property xlCells "Item" row 9 area)
       )
    )
    (prompt "\nChon khung pline:")
  )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (mapcar '(lambda (x) (redraw x 4)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X")))))
  (redraw)
  (princ)
)