update theo haanh:

- Set layer cho ống & cút

- Xoá 3dpolyline

 

- hihi nhoc test tí  ^^

;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"...
>>

update theo haanh:

- Set layer cho ống & cút

- Xoá 3dpolyline

 

- hihi nhoc test tí  ^^

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

E cảm ơn bác nhiều. nhưng cty e dùng CAD LT bản quyền và chạy thêm CADSTA Max hỗ trợ nên lisp này k dùng dk. bác có cách nào khắc phục dk k ah?

Mình không biết CAD LT hạn chế cái gì mà chạy không được

Nếu CADLT bạn đang sử dụng chạy với mã Lisp này thì mình sẽ viết bổ sung thêm...

E cảm ơn bác nhiều. nhưng cty e dùng CAD LT bản quyền và chạy thêm CADSTA Max hỗ trợ nên lisp này k dùng dk. bác có cách nào khắc phục dk k ah?

Mình không biết CAD LT hạn chế cái gì mà chạy không được

Nếu CADLT bạn đang sử dụng chạy với mã Lisp này thì mình sẽ viết bổ sung thêm cho

Bạn thử xem :

(defun c:dfd (/ ss) 
(if (setq ss (ssget)) (command "._DIMOVERRIDE" "dimblk1" "Dot" "dimblk2" "Dot" "" ss "" ))
)

Bạn thử cái này, quét 2 đường đồng mức rồi nhập số khoảng chia, ở đây là 5.

(defun c:ddm (/ ss sk dd dn lst d1 dis n)
  
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE"))))))
sk (getint "\nSo khoang chia:")
dd (car (vl-sort ss
   '(lambda (x y) (> (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x))
     (vlax-curve-getDistAtParam y (vlax-curve-getEndParam...
>>

Bạn thử cái này, quét 2 đường đồng mức rồi nhập số khoảng chia, ở đây là 5.

(defun c:ddm (/ ss sk dd dn lst d1 dis n)
  
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE"))))))
sk (getint "\nSo khoang chia:")
dd (car (vl-sort ss
   '(lambda (x y) (> (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x))
     (vlax-curve-getDistAtParam y (vlax-curve-getEndParam y))))))
dn (car (vl-remove dd ss))
dd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget dd)))
lst nil
  )
  (repeat (1- sk) (setq lst (cons '() lst)))
 
  (foreach d0 dd 
    (setq d1 (vlax-curve-getclosestpointto dn d0)
 dis (/ (distance d0 d1) sk)
          n 0)    
    (setq lst (mapcar '(lambda (x) (append x (list (polar d0 (angle d0 d1) (* (setq n (1+ n)) dis))))) lst)) 
  )
  (foreach v lst
    (entmake (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline"))
    (list (cons 90 (length v))) (mapcar '(lambda (x) (cons 10 x)) v  )
    ))
  )
  (princ)      
)

Đây bạn, nhưng nó chỉ làm với 2 poly hình dạng gần giống nhau thôi, còn dạng như yên ngựa thì chạy không đúng.

(defun c:ddm (/ ss dd dn lst d1 dis n)  
 
  (defun laydinh (en / l)
    (setq l nil)
    (if (= (cdr (assoc 70 (entget en))) 5) (setq tn t) (setq tn nil))
    (while (not (equal (cdr (assoc 0 (entget (setq en (entnext en))))) "SEQEND"))
      (setq l (cons (cdr (assoc 10 (entget en)))...
>>

Đây bạn, nhưng nó chỉ làm với 2 poly hình dạng gần giống nhau thôi, còn dạng như yên ngựa thì chạy không đúng.

(defun c:ddm (/ ss dd dn lst d1 dis n)  
 
  (defun laydinh (en / l)
    (setq l nil)
    (if (= (cdr (assoc 70 (entget en))) 5) (setq tn t) (setq tn nil))
    (while (not (equal (cdr (assoc 0 (entget (setq en (entnext en))))) "SEQEND"))
      (setq l (cons (cdr (assoc 10 (entget en))) l)))
    (if tn (setq l (cons (last l) l)))
    (reverse l)
  )
  
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "POLYLINE")))))))
  (if (not sokhoang) (setq sokhoang (getint "\nSo khoang chia:")))
  (setq dd (car (vl-sort ss '(lambda (x y) (> (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x))
     (vlax-curve-getDistAtParam y (vlax-curve-getEndParam y))))))
dn (car (vl-remove dd ss))
dd (laydinh dd)
lst nil
  )
  (repeat (1- sokhoang) (setq lst (cons '() lst)))
 
  (foreach d0 dd 
    (setq d1 (vlax-curve-getclosestpointto dn d0)
 dis (/ (distance d0 d1) sokhoang)
          n 0)    
    (setq lst (mapcar '(lambda (x) (append x (list (polar d0 (angle d0 d1) (* (setq n (1+ n)) dis))))) lst)) 
  )
  (command "undo" "be")
  (foreach v lst
    (entmake '((0 . "POLYLINE") (66 . 1)) )
    (foreach v1 v (entmake (list '(0 . "VERTEX") (cons 10 v1))))
    (entmake '((0 . "SEQEND")))       
  )
  (command "undo" "e") (princ)      
)

Bạn dùng lsp này, cái này đo kc từ 2 đầu dg cong, vì nhìu khi mình đâu biết cái nào đầu cái nào đuôi.

Chọn dg cong, điểm đầu và kc tới điểm đó.

(defun C:dkc()
  (defun cach (v p1 len / a1)
    (vlax-curve-getPointatDist v
       (abs (- (vlax-curve-getDistAtPoint v (vlax-curve-getClosestPointTo v p1)) len )))
  )
  (if (/=...
>>

Bạn dùng lsp này, cái này đo kc từ 2 đầu dg cong, vì nhìu khi mình đâu biết cái nào đầu cái nào đuôi.

Chọn dg cong, điểm đầu và kc tới điểm đó.

(defun C:dkc()
  (defun cach (v p1 len / a1)
    (vlax-curve-getPointatDist v
       (abs (- (vlax-curve-getDistAtPoint v (vlax-curve-getClosestPointTo v p1)) len )))
  )
  (if (/= (getvar 'pdmode) 3) (setvar 'pdmode 3))
  (entmake (list '(0 . "POINT")
(cons 10 (cach (car (entsel "\nChon duong cong:")) (getpoint "\nDiem dau:") (getreal "\nDo dai:"))))
  )
  (princ)
)

Tiếp tục:

;;;Bai 2: Tao 10000 doi tuong bang command , ss entmake & nhan xet
;2.1: Tao bang command:
(defun c:test1( / old pt i)
(setq old (mapcar 'getvar '("osmode" "cmdecho")))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
(setq pt (getpoint "\nChon diem: ")
	  i 0
	  st (getvar 'millisecs))
(while (< i 10000)
	(command ".point" pt)
	(setq i (1+ i)
		  pt (list (car pt) (cadr pt) (+ 5 (last pt))))
)
(princ (strcat "\nThoi gian chay 1: " (rtos (/...
>>

Tiếp tục:

;;;Bai 2: Tao 10000 doi tuong bang command , ss entmake & nhan xet
;2.1: Tao bang command:
(defun c:test1( / old pt i)
(setq old (mapcar 'getvar '("osmode" "cmdecho")))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
(setq pt (getpoint "\nChon diem: ")
	  i 0
	  st (getvar 'millisecs))
(while (< i 10000)
	(command ".point" pt)
	(setq i (1+ i)
		  pt (list (car pt) (cadr pt) (+ 5 (last pt))))
)
(princ (strcat "\nThoi gian chay 1: " (rtos (/ (- (getvar 'millisecs) st) 1000.) 2 4) " giay."))
(mapcar 'setvar '("osmode" "cmdecho") old)
(princ)
)
;=============
(defun c:test2( / old pt i st cmd)
(setq old (mapcar 'getvar '("osmode" "cmdecho")))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
(setq pt (getpoint "\nChon diem: ")
	  i 0
	  st (getvar 'millisecs))
(while (< i 10000)
	(entmake (list
		'(0 . "POINT")
		(cons 10 pt)
	))
	(setq i (1+ i)
		  pt (list (car pt) (cadr pt) (+ 5 (last pt))))
)
(princ (strcat "\nThoi gian chay 2: " (rtos (/ (- (getvar 'millisecs) st) 1000.) 2 4) " giay."))
(mapcar 'setvar '("osmode" "cmdecho") old)
(princ)
)
;======================
;;ket qua test
;Command: TEST2

;Chon diem:
;Thoi gian chay 2: 0.2500 giay.

;Command:
;Command: TEST1

;Chon diem:
;Thoi gian chay 1: 1.4530 giay.
;;;=======>>> entmake chay nhanh hon command nhieu, 
;;;==>>> & nhuoc diem cua entmake la code dai, de phat sinh loi khi chua quen !!!
;;=====================================================================================================
;;Bai3: entmake 1 dtuong bang layer ko ton tai ==> nhan xet
(entmake (list '(0 . "POINT") '(8 . "VD") (cons 10 (getpoint "\nChon diem: "))))
;===> NX: layer tu sinh ra voi cac dac tinh tuong tu layer "0" (mau 7, continuous)

- anh Ket nhoc xin nộp bài C8 ^^

;==================================================BAI 1================================================================
;a ve line qua 2 diem
(defun K:line (pt1 pt2 layer clr / lst)
(setq lst (list
          '(0 . "LINE")
		  (cons 8 (if layer layer (getvar "Clayer")))
		  (cons 62 (if clr clr 256))
		  (cons 10 pt1)
		  (cons 11 pt2)))
(entmakex lst)
)
;b ve duong tron biet tam va duong kinh
(defun K:circle (pt dk...
>>

- anh Ket nhoc xin nộp bài C8 ^^

;==================================================BAI 1================================================================
;a ve line qua 2 diem
(defun K:line (pt1 pt2 layer clr / lst)
(setq lst (list
          '(0 . "LINE")
		  (cons 8 (if layer layer (getvar "Clayer")))
		  (cons 62 (if clr clr 256))
		  (cons 10 pt1)
		  (cons 11 pt2)))
(entmakex lst)
)
;b ve duong tron biet tam va duong kinh
(defun K:circle (pt dk layer clr / lst)
(setq lst (list
             '(0 . "CIRCLE")
			 (cons 8 (if layer layer (getvar "Clayer")))
		     (cons 62 (if clr clr 256))
			 '(100 . "AcDbCircle")
			 (cons 10 pt)
			 (cons 40 (/ dk 2.0))))
(entmakex lst)
)
;c ve tam giac deu pit 1canh va 1 dinh
(defun K:tamgiacdeu (pdinh canh layer clr / lst )
(setq lst (list
           '(0 . "LWPOLYLINE")
		   '(100 . "AcDbEntity")
		    (cons 8 (if layer layer (getvar "Clayer")))
		    (cons 62 (if clr clr 256))
			'(100 . "AcDbPolyline")
			(cons 90 3)
			(cons 70 1)
			(cons 10 pdinh)
			(cons 10 (polar pdinh 0 canh))
			(cons 10 (polar pdinh (/ (* 60 pi) 180) canh))))
(entmakex lst)
)
; d ve hinh chu nhat biet toa do 2 goc cheo
(defun K:chunhat (p1 p2 layer clr / lst)
(setq lst (list
           '(0 . "LWPOLYLINE")
		   '(100 . "AcDbEntity")
		    (cons 8 (if layer layer (getvar "Clayer")))
		    (cons 62 (if clr clr 256))
			'(100 . "AcDbPolyline")
			(cons 90 4)
			(cons 70 1)
			(cons 10 p1)
			(cons 10 (polar p1 (/ pi 2) (- (cadr p2) (cadr p1))))
			(cons 10 p2)
			(cons 10 (polar p1 0 (- (car p2) (car p1))))
			))
(entmakex lst)
)
; e ve hinh vuong biet toa do 1 diem va chieu dai 1 canh
(defun K:vuong (pt a layer clr / lst)
(setq lst (list
           '(0 . "LWPOLYLINE")
		   '(100 . "AcDbEntity")
		    (cons 8 (if layer layer (getvar "Clayer")))
		    (cons 62 (if clr clr 256))
			'(100 . "AcDbPolyline")
			(cons 90 4)
			(cons 70 1)
			(cons 10 pt)
			(cons 10 (polar pt (/ pi 2) a))
			(cons 10 (polar pt (/ pi 4) (* a (sqrt 2))))
			(cons 10 (polar pt 0 a)))
			)
(entmakex lst)
)
; f ve ellisp biet toa do 3 dinh
(defun K:ellisp (p1 p2 p3 layer clr / lst tam)
(setq tam (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)))
(setq lst (list
           '(0 . "ELLIPSE")
		   '(100 . "AcDbEntity")
		    (cons 8 (if layer layer (getvar "Clayer")))
		    (cons 62 (if clr clr 256))
			'(100 . "AcDbEllipse")
			(cons 10 tam)
			(cons 11 (list (- (car p1) (car tam)) (- (cadr p1) (cadr tam)) 0.0))
			(cons 40 (/ (distance p3 tam) (distance tam p1))))
			)
(entmakex lst)
)
; g ham ve cung trong di qua 3 diem
(defun K:arc (p1 p2 p3 layer clr / lst tam timtam ang1 ang2 ang3)
(defun K:timtam (p1 p2 p3 / a b)
(setq a (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)) b (polar p2 (angle p2 p3) (/ (distance p2 p3) 2.0)))
(inters a (polar a (- (angle p1 p2) (/ pi 2)) 9000) b (polar b (- (angle p2 p3) (/ pi 2)) 9000) nil)
)
(setq tam (K:timtam p1 p2 p3))
(setq ang1 (angle tam p1) ang2 (angle tam p2) ang3 (angle tam p3))
(if (or (< ang1 ang2 ang3) (< ang2 ang3 ang1) (< ang3 ang1 ang2))
  (progn
      (setq dxf50 ang1 dxf51 ang3))
   (progn
      (setq dxf50 ang3 dxf51 ang1))
)
(setq lst (list
             '(0 . "ARC")
			 '(100 . "AcDbEntity")
			 (cons 8 (if layer layer (getvar "Clayer")))
		     (cons 62 (if clr clr 256))
			 '(100 . "AcDbCircle")
              (cons 10 tam)
              (cons 40 (distance tam p1))
             '(100 . "AcDbArc")
              (cons 50 dxf50)
              (cons 51 dxf51)
))
(entmakex lst)
)
;===============================================****************************++++++++++BAI 4+++++++++*********************===========
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list 
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
			   '(70 . 0)
                (cons 2 ten)
                (cons 62 clr))
)
)
)
;===========================================================================================so sanh command entmake
(defun c:kko(/ pt bk)
(setq bk (getreal "\nnhap:"))
(setq pt (getpoint "\ndatdiem:") begin (getvar "millisecs"))
(repeat 10000
(K:circle pt bk nil nil)
)
(setq end (getvar "millisecs"))
(princ (strcat "tong thoi gian thuc hien : " (rtos (/ (- end begin) 1000.0)) " giay"))
(princ)
)
;=====================
(defun c:kkj(/ pt bk)
(setvar "cmdecho" 0)
(setq bk (getreal "\nnhap:"))
(setq pt (getpoint "\ndatdiem:") begin (getvar "millisecs"))
(repeat 10000
(command ".circle" pt bk)
)
(setq end (getvar "millisecs"))
(princ (strcat "tong thoi gian thuc hien : " (rtos (/ (- end begin) 1000.0)) " giay"))
(setvar "cmdecho" 1)
(princ)
)			

- câu so sánh nhoc thử với entmake thì ok, còn command thì máy nhoc đơ lun kaka ^^

- câu tạo đối tượng có kèm layer, layer ko có trước thì vẫn tạo ra layer với tên mình đặt các thông số còn lại nó sẽ lấy mắc mặc định

Đây là code theo mô tả của bạn.

(defun c:test ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
ss1 (vl-remove-if-not '(lambda (x) (and (= (dxf 0 x) "LWPOLYLINE")  (= (dxf 8 x) "LAYER1"))) ss)
ss2 (vl-remove-if-not '(lambda (x) (= (dxf 8 x) "LAYER2")) ss)
ss3 (vl-remove-if-not '(lambda (x) (= (dxf 0 x) "TEXT")) ss)
  )
)

Giải thích :

ss là...

Đây là code theo mô tả của bạn.

(defun c:test ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
ss1 (vl-remove-if-not '(lambda (x) (and (= (dxf 0 x) "LWPOLYLINE")  (= (dxf 8 x) "LAYER1"))) ss)
ss2 (vl-remove-if-not '(lambda (x) (= (dxf 8 x) "LAYER2")) ss)
ss3 (vl-remove-if-not '(lambda (x) (= (dxf 0 x) "TEXT")) ss)
  )
)

Giải thích :

ss là list gồm các đtượng được chọn.

ss1 :   loại bỏ các ptu của ss nếu không phải là pline và không thuộc layer1

ss2  :  loại bỏ các ptu của ss nếu không  thuộc layer2

ss3 :   loại bỏ các ptu của ss nếu không phải là text.

Trong CAD :

Sử dụng script hoặc lisp tạo script hoặc viết form fill image slide vào.

Mình đóng gói 1 ví dụ cho bạn đây

http://www.cadviet.com/upfiles/3/24067_sv.rar

Code LSP :

(defun c:sv( / display_image sldpath slides dial_id sldx sldy)
(vl-load-com)
(defun display_image (img sldx sldy)
(start_image...
>>

Trong CAD :

Sử dụng script hoặc lisp tạo script hoặc viết form fill image slide vào.

Mình đóng gói 1 ví dụ cho bạn đây

http://www.cadviet.com/upfiles/3/24067_sv.rar

Code LSP :

(defun c:sv( / display_image sldpath slides dial_id sldx sldy)
(vl-load-com)
(defun display_image (img sldx sldy)
(start_image "slideimg")
(fill_image 0 0 sldx sldy -2)
(end_image)
(start_image "slideimg")
(slide_image 0 0 sldx sldy img)
(end_image)
)

(cond
((setq sldpath (getfiled "Select a Slide in Folder" "c:\\" "sld" 8))
(setq sldpath (strcat(vl-filename-directory sldpath)"\\")
slides (vl-directory-files sldpath "*.sld")
dial_id (load_dialog "slideview")
)
(new_dialog "slideview" dial_id)
(setq sldx(dimx_tile "slideimg")
sldy(dimy_tile "slideimg")
)
(start_list "slidelist")
(mapcar 'add_list slides)
(end_list)
(action_tile "slidelist"
"(display_image(strcat sldpath(nth(atoi $value)slides))sldx sldy)"
)
(setq next(start_dialog))
(unload_dialog dial_id)
)
)
(princ)
)

Code DCL :

// slideview.dcl

slideview : dialog {
label = "Slide Viewer";
: boxed_row {
: column {
: list_box {
label = "Slide List:";
key = "slidelist";
width = 20;
height = 24;
}
: button {
key = "exit";
label = "Exit";
is_cancel = true;
mnemonic = "E";
}
}
: image {
key = "slideimg";
aspect_ratio = 1.0;
fixed_width = true;
width = 114;
fixed_height = true;
height = 31.75;
color = graphics_background;
}
}
}	

Cái này cũng search thấy nhiều quá luôn

Trong CAD :

Sử dụng script hoặc lisp tạo script hoặc viết form fill image slide vào.

Mình đóng gói 1 ví dụ cho bạn đây

http://www.cadviet.com/upfiles/3/24067_sv.rar

Code LSP :

(defun c:sv( / display_image sldpath slides dial_id sldx sldy)
(vl-load-com)
(defun display_image (img sldx sldy)
(start_image...
>>

Trong CAD :

Sử dụng script hoặc lisp tạo script hoặc viết form fill image slide vào.

Mình đóng gói 1 ví dụ cho bạn đây

http://www.cadviet.com/upfiles/3/24067_sv.rar

Code LSP :

(defun c:sv( / display_image sldpath slides dial_id sldx sldy)
(vl-load-com)
(defun display_image (img sldx sldy)
(start_image "slideimg")
(fill_image 0 0 sldx sldy -2)
(end_image)
(start_image "slideimg")
(slide_image 0 0 sldx sldy img)
(end_image)
)

(cond
((setq sldpath (getfiled "Select a Slide in Folder" "c:\\" "sld" 8))
(setq sldpath (strcat(vl-filename-directory sldpath)"\\")
slides (vl-directory-files sldpath "*.sld")
dial_id (load_dialog "slideview")
)
(new_dialog "slideview" dial_id)
(setq sldx(dimx_tile "slideimg")
sldy(dimy_tile "slideimg")
)
(start_list "slidelist")
(mapcar 'add_list slides)
(end_list)
(action_tile "slidelist"
"(display_image(strcat sldpath(nth(atoi $value)slides))sldx sldy)"
)
(setq next(start_dialog))
(unload_dialog dial_id)
)
)
(princ)
)

Code DCL :

// slideview.dcl

slideview : dialog {
label = "Slide Viewer";
: boxed_row {
: column {
: list_box {
label = "Slide List:";
key = "slidelist";
width = 20;
height = 24;
}
: button {
key = "exit";
label = "Exit";
is_cancel = true;
mnemonic = "E";
}
}
: image {
key = "slideimg";
aspect_ratio = 1.0;
fixed_width = true;
width = 114;
fixed_height = true;
height = 31.75;
color = graphics_background;
}
}
}	

Cái này cũng search thấy nhiều quá luôn

Tặng bạn cái máy chiếu phim di động mini.

Mở cái folder chứa file sld, nhấp đại file nào trong đó để lấy tên folder, mỗi slide sau khi xăm xoi thấy ok rồi thì nhấn space hoặc enter để chiếu cái tiếp theo.

(defun c:vsl()
  (if slddir
    (setq slddir (vl-filename-directory  (getfiled "Open file" (strcat slddir "\\") "sld" 4)))
    (setq slddir (vl-filename-directory (getfiled...
>>

Tặng bạn cái máy chiếu phim di động mini.

Mở cái folder chứa file sld, nhấp đại file nào trong đó để lấy tên folder, mỗi slide sau khi xăm xoi thấy ok rồi thì nhấn space hoặc enter để chiếu cái tiếp theo.

(defun c:vsl()
  (if slddir
    (setq slddir (vl-filename-directory  (getfiled "Open file" (strcat slddir "\\") "sld" 4)))
    (setq slddir (vl-filename-directory (getfiled "Open file" (getvar "dwgprefix") "sld" 4)))    
  )
  (foreach slide (vl-directory-files slddir "*.sld" 1)    
    (command "VSLIDE" (strcat slddir "\\" slide))
    (getstring)
  )
  (redraw)
)

- hi nhoc góp vui tí ^^, các dạng đường cong nhoc nghĩ chỉ có  cách chọn mới tính đc chiều dài của nó, nhoc mót đc của mấy anh, viết lại để tính riêng cho dạng đường cong, bạn dùng thử xem, còn gộp 2 cái của anh Tue lun thì suy nghĩ thêm ^^

;;;--------------------------------------------------------------------
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam...
>>

- hi nhoc góp vui tí ^^, các dạng đường cong nhoc nghĩ chỉ có  cách chọn mới tính đc chiều dài của nó, nhoc mót đc của mấy anh, viết lại để tính riêng cho dạng đường cong, bạn dùng thử xem, còn gộp 2 cái của anh Tue lun thì suy nghĩ thêm ^^

;;;--------------------------------------------------------------------
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TLC(/ L edd ss1 e)
(prompt "Chon duong cong mun tinh kich thuoc")
(while (setq ss1 (ssget "+.:E:S" (list (cons 0 "ARC,CIRCLE,ELLIPSE,SPLINE"))))
(progn
(setq L 0.0)
(while (setq e (ssname ss1 0))    
	(setq L (+ L (length1 e)))    
	(ssdel e ss1))
(setq edd (entget (car (entsel "\nchon text ghi ket qua:"))))
(entmod (subst (cons 1 (rtos L 2 2)) (assoc 1 edd) edd))
)
)
(princ "\n")
(princ "xong")
(princ)
)

Ek :wacko: , thay dòng (getstring) bằng (command "delay" "3000") thì thử trong Folder có 3 slide lisp chạy dừng 3s cái rẹt luôn 1 hình :blink: khỏi thấy 2 hình kia :wub:

Trong trường hợp này Delay không được. Thì chuyển qua Wait vậy.

- ah vậy ý bạn đó là lấy khoảng cách 2 điểm bất kỳ thuộc đường đã chọn ^^, theo gợi ý anh Ket nhoc viết lại thế này xem bạn đó vừa ý chưa hì :)

;=======================
(defun _d2p(e p1 p2) ;Getdist along curve by : Ename P1 P2	
	(abs (apply '- (mapcar '(lambda(x)(vlax-curve-getDistAtPoint e (trans (vlax-curve-getclosestpointto e x) 1 0))) (list p1 p2))))
)
;====================================
(defun...
>>

- ah vậy ý bạn đó là lấy khoảng cách 2 điểm bất kỳ thuộc đường đã chọn ^^, theo gợi ý anh Ket nhoc viết lại thế này xem bạn đó vừa ý chưa hì :)

;=======================
(defun _d2p(e p1 p2) ;Getdist along curve by : Ename P1 P2	
	(abs (apply '- (mapcar '(lambda(x)(vlax-curve-getDistAtPoint e (trans (vlax-curve-getclosestpointto e x) 1 0))) (list p1 p2))))
)
;====================================
(defun C:TL3(/ ss L te p1 p2 textmau P enty old)
(setq old (getvar 'osmode))
(setvar 'osmode 545)
(prompt "chon doi tuong")
(while (and 
            (setq ss (ssget "+.:E:S" (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
            (setq p1 (getpoint "\n Chon diem thu nhat :")) 
            (setq p2 (getpoint p1 "\n Chon diem thu hai :"))
			)
(setq enty (ssname ss 0))
(setq L (_d2p enty p1 p2))
(setq p (getpoint "\nPick diem chen hoac enter bo qua de chon Text :"))
 
(cond ((/= p nil)
  
    (if (not textmau) (setq textmau (car(entsel "\nChon Text mau:"))))
    (entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau)) 
  (cons 10 p) (cons 11 p) (assoc 7 (entget textmau)) 
    ))
  )
  ((= p nil)
  (setq te (entget (car (entsel "\n Chon Text de gan ket qua :")))
        te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
  )
)
(princ "\n")
(prompt "chon doi tuong")
)
(setvar 'osmode old)
(princ)
)

Thanks bạn Doan Van Ha :) .Test đã OK. Nhưng nếu có thể cho trình chiếu lập lại cho đến khi Enter kết thúc trình chiếu thì lisp này tuyệt vời :P .

Được voi đòi 2 bà Trưng hè!

Lisp đây! Nó lặp hết 1 lượt trong thư...

Thanks bạn Doan Van Ha :) .Test đã OK. Nhưng nếu có thể cho trình chiếu lập lại cho đến khi Enter kết thúc trình chiếu thì lisp này tuyệt vời :P .

Được voi đòi 2 bà Trưng hè!

Lisp đây! Nó lặp hết 1 lượt trong thư mục thì lại lặp lượt khác, chừng nào chưa nhấn Enter hoặc Space.

- nhoc mới viết đc phần chính ^^, ban test xem có đúng ý bạn chưa, sau khi chọn Pline lsp sẽ xuất bảng thông báo danh sách các cạnh và các góc kẹp, bạn nên làm thủ công trước rùi dùng lsp xem lsp trả về có đúng chưa hì ^^, nếu ok bạn trình bày rõ kết quả cuối cùng bạn mún nó như thế nào nhoc sẽ mông má lại lsp, file cad minh họa càng tốt ^^

>>

- anh Ket khi nào a happy trở lại xem dùm nhoc hen, lang thang nhot mót đc làm lại hàm vẽ thang gọn hơn liên tục hơn = pline ^^

;; 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) ") :")))(a))))
	((= (type a) 'STR) (setq a...
>>

- anh Ket khi nào a happy trở lại xem dùm nhoc hen, lang thang nhot mót đc làm lại hàm vẽ thang gọn hơn liên tục hơn = pline ^^

;; 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) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;;;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))))
;;;;;    
;;;;ve cau thang
(defun kkkv ()
(command ".pline")
                          (command pt)
		                    (repeat sb
						       (command (strcat "@0," (rtos cb))) 
                               (command (strcat "@" (rtos rb) ",0"))
                               							   
						     )
							 (command "")
)
;;;;
(defun danhso (/ codanh ptn ptn1)
(initget "Y N")
(setq codanh (Xstrcase (getkword "\nBan co mun danh so bac < Y / N > :")))
(if (= codanh "N") (setq codanh nil) (setq codanh t))
(if codanh
						  (progn
						  (setq ptn (polar pt (/ pi 2) (+ cb 0.05)))
                                                  (setq ptn1 (list (+ (car pt) rb) (+ (cadr pt) cb) 0)) 					  
						  (repeat sb
							 (command "text" ptn (/ cb 1.5) 0 (itoa (setq i (1+ i))))
							 (setq ptn (polar ptn (angle pt ptn1) (distance pt ptn1))))
						  (kkkv)
							 
						   )
						 (kkkv)
						 )
)


;;;; bai 7 + 8 : ve cau thang them lua chon co danh so bac hay ko ^^
(defun c:vktt (/ lst_va old key pt4 pt5 pt6 pt7 )
(setq lst_va '("osmode" "cmdecho" "ANGDIR" "ANGBASE" "AUNITS"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(1 0 0 0 0))
(emk_style "danhso" "Ariali.ttf")
(setvar "textstyle" "danhso")
(setq i 0)
;(initget "Y N")
;(setq codem (Xstrcase (getkword "\nBan co mun danh so bac <Enter=Yes/No>: ")))
;(if (= codem "N") (setq codem nil) (setq codem t))
(initget 1 "A B C")
(setq key (Xstrcase (getkword "\nAsobacktbac Bcaonhasobacrongbac Ccaonhasobacgocnghieng <A/B/C>:")))
(cond 
           ((= key "A")
		        (if (and 
				        (setq pt (getpoint "\nchon diem dat:"))
						(setvar "osmode" 0)
				         (setq sb (getvalue sb 7 "nhap so bac")
				               rb (getvalue rb 0.25 "nhap chieu rong bac")
						       cb (getvalue cb 0.2 "nhap chieu cao bac")))
							   
							   
						(danhso)
                 )
            )
			((= key "B")
			     (if (and 
				        (setq pt (getpoint "\nchon diem dat:"))
						(setvar "osmode" 0)
						(setq cnha (getvalue cnha 3.5 "nhap do cao nha")
						      sb (getvalue sb 9 "nhap so bac")
							  rb (getvalue rb 0.25 "nhap chieu rong bac")
							  cb (/ cnha sb)))
					 (danhso)
				  )
			)
			((= key "C")
			       (if (and   
				          (setq pt (getpoint "\nchon diem dat:"))
						  (setvar "osmode" 0)
						  (setq cnha (getvalue cnha 4.0 "nhap chieu cao nha")
						        sb (getvalue sb 11 "nhap so bac thang:")
								gocng (getvalue gocng 45.0 "nhap goc nghieng")
								cb (/ cnha sb)
								pt4 (polar pt (* PI (/ 90 180.0)) cb)
								pt5 (polar pt4 0 100)
								pt6 (polar pt (* PI (/ gocng 180.0)) 100)
								pt7 (inters pt pt6 pt4 pt5 nil)
								rb (sqrt (- (expt (distance pt pt7) 2) (expt cb 2)))))
						(danhso)
					)
				)
)
(command ".zoom" "e")
(mapcar 'setvar lst_va old)
(princ)
)