Chuyển đến nội dung
Diễn đàn CADViet

hiepttr

Thành viên
  • Số lượng nội dung

    1237
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    51

Bài đăng được đăng bởi hiepttr


  1. Còn chần chờ gì nữa mà ko tiếp bước 2, bước 3 ..... bước n đi haanh ?!

     

    >>> Phần 1:

    (defun c:KTCV( / Rnho Rlon P S Dng Dtr x y Dtb)
    (defun ch(a b) (sqrt (+ (* a a) (* b b))))
    ;====
    (setq Rnho (getdist "\nNhap ban kinh nho (r): ")
    	  Rlon (getdist "\nNhap ban kinh lon (R): ")
    	  P (getdist "\nNhap buoc vit (P): ")
    	  S (getdist "\nNhap chieu day tam thep (S): "))
    (cond ((and Rnho Rlon P S)
    	(setq Dng (/ (ch (* 2 pi Rlon) P) pi)
    		  Dtr (/ (ch (* 2 pi Rnho) P) pi)
    		  x (sqrt (- (* (- Rlon Rnho) (- Rlon Rnho)) (/ (* (- Dng Dtr) (- Dng Dtr)) 4.)))
    		  y (/ (* x 0.5 S) (- Rlon Rnho))
    		  Dtb (- Dng (* 2 y))))
    )
    )
    

    P/s:

    haanh cần đưa nguyên cục vậy để mình lựa chọn giải pháp để khỏi tốn công vô ích

    chứ viết lisp mà cứ rặn .... từng tí vậy là ức chế lắm đó ^ ^

     

    :D :D :D

    • Vote tăng 1

  2. @haanh:

    Để bước 1 thành công suôn sẻ_ tránh tình trạng "nhầm nhọt trong trồng trọt" mình muốn haanh khẳng định cho mình 1 điều:

    Có phải chân dim Dtb là giao của đường nằm ngang với đường ofset s/2 màu xanh ở hình trong #4 ?!

     

    p/s:

    Lisp đường ống cần nâng cấp thế nào nữa ?! Làm luôn đi để khỏi phải mất công dò lại code khi trường hợp để quá lâu rồi vọc lại

    • Vote tăng 1

  3. - Đúng là mình "tận dụng triệt để" các hàm của bác Thaistreetz ^ ^ :D

    - Hai cái bảo bối Ket cho, cái trên mình hiểu

    Còn cái dưới sao mà kho tiêu thế ??? Két có thể mổ xẻ đôi chút ko ?!

    Thanks !

     

    p/s:

    (vlax-invoke obj1 'IntersectWith obj2 mode) >>> OK

    (if (cddr l)
    (cons (list (car l) (cadr l) (caddr l)) >>> OK

     

    Còn phần khác thì bó chiếu :D :D :D


  4. Đâ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)
    	)
    	)
    )
    

  5. Đã 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))))
    )
    

  6. Mình thấy cách tính nào cũng xuất phát từ quan hệ giữa chiều dài cung với bán kính và số đo góc:

    L = R * (anpha) ..... (góc tính bằng radian)

    cả haanh ah !

     

    Tuy nhiên, hình như bác Bình đánh nhầm R = U*A/(U-E) thành ra "Mình tính R = (U * E) / (U-E)"

    Mình nghĩ chỉ là lỗi đánh máy thôi ! vì với bác Bình mình tin "bác sẽ có cách" ^ ^

     

    Hai "trường phái" giữa haanh & bác Bình chỉ khác khi một bên có "cháu K1, K2" còn bên kia là "bề dày chia 2"

     

    Túm lại: mình sẽ ko chịu trách nhiện cho cái sai số kia, chỉ biết haanh cung cấp công thức & mình code, OK !

    :D :D :D

    • Vote tăng 1

  7. @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))))
    )
    
    • Vote tăng 1

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

  9. -nhoc rố rùi ^^, cái hàm anh Duan gợi ý cho nhoc, nhoc vẫn chưa bắt đc lắm, nhưng nhoc thấy cài hàm đầu hiểu sơ là nó dò thằng 10 gần = nhau.

    - còn cái dòng nhoc lấy lst nếu là line của a Tot thì là nó lấy theo từng cặp 10 11 của 1 đối tượng, sau đó rãi block nên có sự trùng nhau nếu là line nối tiếp nhau 

    - nhoc ko pit dùng cách nào để so sánh giữa thằng 11 của thằng này với 10 của thằng khác có gần = nhau ko

    - cái lst của a Tot nó trả về dạng này

    - nhoc thử tách lấy thằng 10 riêng, 11 riêng bằng cách này

    rồi nối 2 thằng lại với nhau để có thể loại đc thằng nào trùng nhau, nhưng cái lsp nối nó trả về dạng này @@

    - nếu mà nó trả về giống dòng đầu mà dạng này thằng 10 và 11 của từng đối tượng thành 1lsp rời vô chung 1 lst tổng mà ko phải dạng phức 10 với 11 thành 1lst riêng trong lst tổng thì dể xử rùi hix

    @ Nhóc:

    + Nếu muốn "gói bánh" (thêm cặp ngoặc) thì dùng các hàm LIST, QUOTE ...

    + Nếu muốn "bóc bánh" (gỡ cặp ngoặc) thì dùng các hàm CAR, LAST, NTH ...

     

    Là lý thuyết cũ cả, sao Nhóc lại rối lên vậy ??? :D :D :D


  10. @Hoằn: Trong hình trên, con số thì có vẻ đúng nhưng phần ghi chú sai thì phải:
    + Con số 320.... mình ko biết dân chuyên ngành gọi là gì, song, nó là chu vi "đường tròn chân cánh vít" ~ chu vi mặt cắt trục

    >>>> công thức C = pi * D = pi * 2 *r    mới đúng ^^ :D :D :D

     

    Nói chung, phần tính toán cơ bản là hình học >>> OK

    Riêng đoạn Dtb là của dân cơ khí (?)

    Hoằn có thể giải thích vì sao ko lấy Dng tính luôn mà phải xác định Dtb, hay nói cách khác: Dtb này xét tới sai số về cái gì ?

    :D :D :D

     

    p/s: Dân ngoài ngành, tò mò tí, Hoằn thích thì trả lời, ko thích thì thôi :D  Rảnh mình sẽ thử code lisp :D :D :D

    • Vote tăng 1

  11. 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)
    )
    
    • Vote tăng 2

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

     

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

     

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

      - Cho bóng di động

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

     

    p/s:

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

    :D :D :D

     

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

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

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

     

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

    Thanks !

     

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