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

nhoclangbat

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

    1.306
  • Đã tham gia

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

  • Ngày trúng

    35

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


  1. - y/c của bạn cũng ngộ ngộ, nhoc thử viết như vậy bạn test thử hen ^^

    ;========================================================================================
    (defun ReplaceString (old_str new_str str / m n) (vl-load-com)
    (setq m 0 n (strlen new_str))
    (while (setq m (vl-string-search old_str str m))
    (setq str (vl-string-subst new_str old_str str m))
    (setq m (+ n m))
    )
    str
    )
    ;========================================================================================
    (defun tachsym(str sym / datach kytu dem lstdatach)
      (setq dem 1)
      (while (<= dem (strlen str))
        (setq datach "")
        (setq kytu (substr str dem 1))
        (while (and (/= kytu sym) (<= dem (strlen str)))
          (setq datach (strcat datach kytu))
          (setq dem (+ dem 1))
          (setq kytu (substr str dem 1))
        ); end while con
        (setq dem (+ dem 1))
        (setq lstdatach (append lstdatach (list datach)))
      ) ;end while me
      datach
    )
    ;=============================================================
    ;======================================================================================================================
    (defun K:dsbg (table / lst phu)
    (tblnext table t)
    (while (setq phu (tblnext table nil))
    (setq lst (cons (cdr (assoc 2 phu)) lst))
    )
    )
    ;================================
    (defun c:dt(/ tl ntl tl2 h k tdt pt pt1 pt5 ss  frome toe cur dt S laos K:text getvalueK lacol ladin dt ss1 ten K:layer K:style ds_style e1 e1 chon)
    (vl-load-com)
    ;=====================================================================
     ;==================================================
    ;;ham tao text 2
    (defun K:text(pt height string justify layer textstyle mau ang / lst)
    (setq lst (list '(0 . "TEXT")
                                  (cons 10 pt)
    							  (cons 40 height)
    							  (cons 1 string)
    							  (cons 50 (if ang ang 0))
    							  (cons 8 layer)
    							  (cons 7 textstyle)
    							  (cons 62 (if mau mau 256))
    							  
    			)
    			justify (strcase justify))
    		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 pt)))))
    		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 pt)))))
    				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 pt)))))
    				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 pt)))))
    				)
    	(entmakex Lst)
      )	;end K:text
    ;;--------------------------------------
    ;; ham luu gia tri
    (defun getvalueK ( 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 1) ") :")))(a))))
    	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
    ))
    ;;;;
    ;=================================================================================
    (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))
    )
    )
    )
    ;========================================================================================
    ;hàm tạo textstyle
    (defun K:style (MyStyle MyFont)
    (entmake (list    (cons 0 "STYLE")    
    (cons 100 "AcDbSymbolTableRecord")    
    (cons 100 "AcDbTextStyleTableRecord")    
    (cons 2 MyStyle)    (cons 3  MyFont)    
    (cons 70 0))))
    ;=====================================================================================
    (if (= fname nil)
        (setq fname (getfiled "Chon tap tin luu so lieu" "//" "txt" 1))
      )
      (setq fo (open fname "a"))
      (princ "Cac dien tich da chon:" fo)
      (princ "\n" fo)
    ;======================================================================================
     (if (null (tblsearch "layer" "ab-dientich")) (K:layer "ab-dientich" 4))
     (if (null (tblsearch "style" "VAVON")) (K:style "VAVON" "VAVON.ttf"))
    ;===================================================================================
    (setvar "cmdecho" 0)
    (command "undo" "begin")
    (setq lacol (getvar "CEColor"))
    (setq ladin (getvar "dimzin"))
    (setq laos (getvar "osmode"))
    (setq lacl (getvar 'clayer))  
    ;================================================================
    (setq ds_style (vl-princ-to-string (K:dsbg "style")))
    (setq e1 (tachsym ds_style "("))
    (setq e2 (Xstrcase (tachsym e1 ")")))
    (initget 1 e2)
    (setq chon (getkword (strcat "Nh\U+1EADp ch\U+1EEF \U+0111\U+1EA7u t\U+00EAn Style m\U+00FAn set: < "  (ReplaceString " " "/" e2)  " >:")))
    ;========================================================
    (setq tl (getvalueK tl 1000.0 "Mau so Ti le ht "))
    (setq ntl (/ 1000 tl))
    (setq h (getvalueK h 1.8 "Nhap chieu cao text "))
    (setq tl2 (* ntl ntl))
    ;==================================================================
    (setq k 0 tdt 0)
    (setvar "dimzin" 0)
    (setvar "OSMODE" 0)
    ;======================================
    ;;===========================================================
    (initget 1 "Thoat")
    (setq pt1 (getpoint "\n Chon mien tinh dien tich / Thoat : "))
    (while (/= pt1 nil)
    ;(command "erase" ss "")
    (setq k (+ 1 k))
    (K:text pt1 h (itoa k) "M" "k-dem" "VAVON" 1 nil)
    ;-----------------------------------------------------------------------------
    (setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
    (command "cecolor"1 "-boundary" pt1 "");; boundary
    (setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary
    (setq cur frome	ss (ssadd) S 0)
    (while 	(not (eq cur toe));; chon cac doi tuong tu frome den toe
    
    	(setq cur (entnext cur) ss (ssadd cur ss))
    
    	(command "area" "S" "O" ss "" "")
    
    	(setq dt (/ (getvar "AREA") tl2) S (+ S dt))
    
    );while
    
    (command "area" "A" "O" "L" "" "")
    
    (setq dt (/ (getvar "AREA") tl2))
    
    (setq S (+ S (* dt 2))) 
      (setq  tdt (+ s tdt))  
    (princ tdt fo)
    (princ " m2")
    (princ "\n" fo)
    (setvar "CEColor" lacol)
    ;==========================================
    ;===================================================================
    (setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 1) "m2. chon mien do tiep theo...")))
    );while
    ;=======================================================================
    ;(command "erase" ss "")
    ;(setq ss nil)
    (setvar "DIMZIN" ladin)
    ;================================================
    ;=================================================================================
    (initget 1) 
    (setq pt5 (getpoint "\nChon diem dat ket qua:"))
    (K:text pt5 h (strcat (rtos tdt 2 1) "m%%178") "M" "ab-dientich" chon nil nil)
    (setq ss1 (ssget "X" '((0 . "TEXT") (8 . "k-dem"))))
    (if ss1
     (progn
       (repeat (sslength ss1)
    	 (setq ten (ssname ss1 0))
    	 (entdel ten)
    	 (ssdel ten ss1)
    	 )
      )
     )
    ;===============
    (setvar 'clayer lacl)
    ;=====================
    (vl-cmdf "-purge" "layer" "k-dem" "y" "y")
    (setvar "OSMODE" laos)
    (command "undo" "end")
    (close fo)
    (setvar "cmdecho" 1)
    (princ "\n")
    (princ "xong")
    (princ)
    )
     
    
    
    • Vote tăng 1

  2. - hi Chạy trước nhọc chưa hì ^^, khống chế giá trị nhập để đưa vào command nhoc thì chưa nghĩ ra cách nào khác ngoài cách đưa thêm biến phụ nhập góc vào ^^, còn pick điểm thì initget khống chế đc, initget theo nhoc biết thì chưa không chế đc khoảng nhập vào nên dùng vòng lặp tới khi nào thỏa thì ok, Hieu thử xem ^^

    (defun c:roo(/ doigoc start end *error* vars ovars nvars dt db dh dg tt ent lst px pg p_vii)
     (defun doigoc(goc)
      (rem (- 450.0 goc) 360.0))
     (defun start()
      (setq vars '("osmode" "cmdecho" "angdir" "angbase"))
      (setq ovars (mapcar 'getvar vars)
            nvars (mapcar 'setvar vars (list 0 0 1 (/ pi 2)))))
     (defun end()
      (and ovars (mapcar 'setvar vars ovars)))
     (defun *error* (ABC)
      (end))
     (vl-load-com) 
     (princ "Chon Doi Tuong Can Quay: ") 
     (setq dt (ssget)
           db (getpoint "\nChon BasePoint:")
           tt (entsel "\nChon doi duong tam tau: ")
           ent (car tt)
           lst (mapcar 'cdr (vl-remove-if-not '(lambda(x) (or (= (car x) 10) (= (car x) 11))) (entget ent))))
     (command "undo" "be")    
     (start)
     (if (< (distance db (setq px (car lst))) (distance db (setq pg (cadr lst))))
      (progn 
       (princ (strcat "\nGoc Phuong Vi hien tai <" (rtos (doigoc (* 180.0 (/ 1 pi) (angle px pg))) 2 2) ">"))
       (setq p_vii (getreal "\nNhap goc phuong vi:"))
       (while (> p_vii 180.0)
       (setq p_vii (getreal "\nNhap goc phuong vi:")))
       (command ".rotate" dt "" db "r" px pg p_vii)
       )
      (progn 
       (princ (strcat "\nGoc Phuong Vi hien tai <" (rtos (doigoc (* 180.0 (/ 1 pi) (angle pg px))) 2 2) ">"))
        (setq p_vii (getreal "\nNhap goc phuong vi:"))
       (while (> p_vii 180.0)
       (setq p_vii (getreal "\nNhap goc phuong vi:")))   
       (command ".rotate" dt "" db "r" pg px p_vii)
       )
       )
     (end)
     (command "undo" "e"))
    

    - nhoc quên chưa chỉnh khống chế cho thằng db Hieu tự xử hen ^^

    -p/s:nhoc chưa hiểu cái biến tt là gì ^^

    • Vote tăng 1

  3. - nhoc góp xíu ít những gì nhoc hiểu ^^

    - quote với list gần như nhau, khác ở chỗ quote không nhận biến với hàm còn, list thì chơi tuốt ^^, quote thì gọn hơn tí ko phải viết hẳn tên hàm ^^

    '(.....) tương đương (quote .........) => quote dùng để liệt kê phần tử trực tiếp ko thông qua biến hay hàm đc

    - VD:

    (setq a 3 b 5 c "d")

    - dùng quote (setq lst '(a b c)) => trả về (a b c) ^^

    - dùng list (setq lst (list a b c) => trả về (3 5 "d")


  4. - oh vậy là hơi giống bên nhoc ^^, 2 điểm = 100 bạn đó nói chắc đc phóng lên theo tile 1/500 rùi tương đương 2lần , giờ bạn ấy mún đo lấy kích thước thật = 50 tương đương tile 1/1000, nhoc nghĩ vậy ko biết đúg ko ^^

    - bạn thử xem

    (defun c:ckc(/ po1 po2 oldim tp S te ent x)
    (setq oldim (getvar "DIMZIN"))
    (setvar "DIMZIN" 0)
    (setq ttl (getvalueK ttl 500.0 "Nhap ti le ban ve 1 / "))
    (setq x (/ 1000.0 ttl))
    (if (not tpo) (setq tpo 0))
    (setq tp (getint (strcat "\n So chu so thap phan <" (rtos tpo 2 0) ">:")))
    (if (not tp) (setq tp tpo) (setq tpo tp))
    (setq po1 (getpoint "\n Pick diem dau :"))
    
    (while
    (setq po2
    (getpoint po1 "\n Pick diem tiep theo de tinh khoang cach/ Enter de ket thuc :"))
    (setq S (/ (distance po1 po2) x) po1 po2)
    (while (null (setq ent (entsel "\n Pick vao TEXT :")))
    (setq ent (entsel "\n Pick lai vao TEXT :"))
    )
    (setq te (entget (car ent)))
    (setq te (entmod(subst(cons 1 (rtos S 2 tp)) (assoc 1 te) te)))
    )
    (setvar "DIMZIN" oldim)
    (princ)
    )
    ;===
    ;; ham luu gia tri
    (defun getvalueK ( 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 1) ") :")))(a))))
    	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
    ))
    ;;;;
    

  5. - hi tối nay rãnh nhoc tranh thủ mò tí anh Ket với mấy bạn góp ý cho nhoc hen ^^, anh Ket nhoc nộp Ch10-2-3

    ; 1- an doi tuong
    (defun c:khide(/ i )
    (prompt "Ch\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+00FAn \U+1EA9n:")
    (setq doit (ssget))
    (if doit
    (progn
    (setq i 0)
    (repeat (sslength doit)
     (setq ent (ssname doit i))
     (redraw ent 2)
     (setq i (1+ i))
     )
     )
     )
     )
    ;========================== hien doi tuong =================================
    (defun c:khien (/ i)
    (if doit
    (progn
    (setq i 0)
    (repeat (sslength doit)
     (setq ent (ssname doit i))
     (redraw ent 1)
     (setq i (1+ i))
     )
     )
     )
     )
    ;===========================================an nhieu nhom doi tuong=================
    (defun c:khides(/ i ss2ent doit)
    ;=====================================================
    (defun ss2ent (ss / i Le e) 
    (setq i 0)
    (repeat (sslength ss)     
    (setq e (ssname ss i)        
    Le (append Le (list e))        
    i (1+ i)    ))
    Le)
    ;====================================================
    (prompt "Ch\U+1ECDn l\U+1EA7n l\U+01B0\U+1EE3t c\U+00E1c nh\U+00F3m \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+00FAn \U+1EA9n: ")
    (setq doit (ssget))
    (if doit
    (progn
    (setq i 0)
    (setq lst_ent (ss2ent doit))
    (setq nhom_hide (append lst_ent nhom_hide))
    (repeat (length lst_ent)
     (setq ent (nth i lst_ent))
     (redraw ent 2)
     (setq i (1+ i))
     )
     )
     )
     )
    ;===========================hien lai nhieu nhom doi tuong===============================
    (defun c:khiens (/ i nhom_hide doit)
    (if nhom_hide
    (progn
    (setq i 0)
    (repeat (length nhom_hide)
     (setq ent (nth i nhom_hide))
     (redraw ent 1)
     (setq i (1+ i))
     )
     )
     )
     )
     ;==================================
     ;==================
    (defun K:redraw (ss ma / i ent)
    (setq i 0)
    (repeat (sslength ss)     
    (setq ent (ssname ss i))
    (redraw ent ma)        
    (setq i (1+ i))     
    )
    )
    ;=========================xoa tat ca doi tuong tren man hinh, de lai dong text  sau do nhap please de hien lai==============
    (defun c:ktroll (/ doit str)
    (vl-load-com)
    (setvar 'cmdecho 0)
    ;==================
    (defun K:redraw (ss ma / i ent)
    (setq i 0)
    (repeat (sslength ss)     
    (setq ent (ssname ss i))
    (redraw ent ma)        
    (setq i (1+ i))     
    )
    )
    ;===========================
    ;=====================================
    (setq doit (ssget "X"))
    (if doit
    (progn
       (K:redraw doit 2)
       (vl-cmdf ".text" '(0 0) (getvar "textsize") 0 "Ban ve cua ban da bi xoa het ^^")
       (vl-cmdf ".zoom" "o" "last" "")
       )
     )
    ;==============================================
    (while (or (not str) (/= str "Vuilong"))
    (setq str (getstring "\nB\U+1EA1n nh\U+1EADp \U+0111\U+00FAng t\U+1EEB \"Vuilong\" \U+0111\U+1EC3 tr\U+1EA3 l\U+1EA1i vi\U+1EC7c \U+0111ang l\U+00E0m: ")))
    (if (= str "Vuilong")
    (progn
    (vl-cmdf ".erase" "last" "")
    (K:redraw doit 1)
    (vl-cmdf ".zoom" "e")
    )
    )
    (setvar 'cmdecho 1)
    (princ)
    )
    
    ;========================================================
    ;=================bai nhap nhay doi tuong=============
    (defun c:chopchop(/ doit xnhay vnhay trove)
    (vl-load-com)
    (setvar 'cmdecho 0)
    (setq doit (ssget))
    (if doit
    (progn
    (setq xnhay (getint "\nNhap so lan nhay:"))
    (setq vnhay (getint "\nNhap so lan nhay bao nhieu lan / 1s :"))
    (repeat xnhay
    (K:redraw doit 2)
    (vl-cmdf "delay" (/ 500 vnhay))
    (K:redraw doit 1)
    (vl-cmdf "delay" (/ 500 vnhay))
    )
    (textscr)
    (princ (strcat "so doi tuong da chon chop chop : " (itoa (sslength doit))))
    (princ "\n")
    (princ (strcat "thoi gian chay la : " (rtos (/ (* xnhay 2 (/ 500 vnhay)) 1000.0) 2 1) " giay"))
    (princ "\n")
    (setq trove (getstring "\nBan nhap phim bat ky or enter de tro ve man hinh chinh :"))
    (if trove 
    (graphscr))
    )
    )
    (setvar 'cmdecho 1)
    (princ)
    )
    ;===============================
    ;1- ham lay ten cac phan tu trong 1 tab
    (defun K:dsbg (table / lst phu)
    (tblnext table t)
    (while (setq phu (tblnext table nil))
    (setq lst (cons (cdr (assoc 2 phu)) lst))
    )
    )
    ;===================================
    (defun K:get (table ten)
    (entget (tblobjname table ten))
    )
    ;==================================
    ; 3 - bat tat layer
    (defun K:btlay(tenlayer / phu)
    (setq phu (K:get "layer" tenlayer))
    (entmod (subst (cons 62 (* -1 (cdr (assoc 62 phu)))) (assoc 62 phu) phu))
    )
    ;===============================bai hightlight tat ca doi tuong tru layer 0=================
    (defun c:khl (/ doit ds_lay ds_layoff lay_off)
    (vl-load-com)
    (setvar 'cmdecho 0)
    (vl-cmdf ".zoom" "e")
    (setq doit (ssget "X" '((8 . "~0"))))
    (if doit
     (progn
     
    ;==========================================
    (setq ds_lay (K:dsbg "layer"))
    (foreach x ds_lay
    (if (< (cdr (assoc 62 (K:get "layer" x))) 0)
    (progn
    (setq lay_off x)
    (setq ds_layoff (cons lay_off ds_layoff)))
    )) ;end foreach ds_lay
    ;==========================
    (foreach k ds_layoff
    (K:btlay k))
    (K:redraw doit 3)
    (while (or (not str) (/= str "")) (setq str (getstring "\nBan nhan Enter de tro ve trang thai cu :")))
    (if (= str "")
    (progn
    (foreach d ds_layoff
    (K:btlay d))
    (K:redraw doit 4)
    )
    )
    ;======================================================================
    )
    )
    (setvar 'cmdecho 1)
    (princ)
    )
    ;===========================================================================END 10-2====================================================
    ;;;hàm lư giá trị mặc định 3
    (defun getvalueK ( 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 1) ") :")))(a))))
    	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
    ))
    ;=================================================================BEGIN 10-3 ============================================================
    ;=== ve duong bao xung quan vong tron====
    (defun c:tronbox(/ doit i tam bk d ptt ptp pdt pdp ds_ent)
    (prompt "Chon duong tron:")
    (setq doit (ssget '((0 . "CIRCLE"))))
    (if doit
           (progn
    	       (setq ofset (getvalueK ofset 0.0 "Nhap khoang offset")
                     clr (getvalueK clr 1 "Nhap mau khung")
                      i 0)
               (repeat (sslength doit)
                  (setq ds_ent (entget (ssname doit i))
    			        tam (cdr (assoc 10 ds_ent))
    					bk (cdr (assoc 40 ds_ent))
    					d (+ bk ofset)
    					ptt (mapcar '+ tam (list (- d) d))
    					ptp (mapcar '+ tam (list d d))
    					pdt (mapcar '+ tam (list (- d) (- d)))
    					pdp (mapcar '+ tam (list d (- d)))
    				)
    			 (grdraw ptt ptp clr 1)
    			 (grdraw pdt pdp clr 1)
    			 (grdraw ptt pdt clr 1)
    			 (grdraw ptp pdp clr 1)
    			 (setq i (1+ i))
    			 )
    		)
    )
    (princ)
    )
    ;================================
    ;=======ve duong tron ao==========
    (defun c:tronxao (/ i dau pt1 pt2 f ds_pt)
    (setq tam (getpoint "\nChon tam:")
          bk (getvalueK bk 5.0 "Nhap ban kinh "))
    (setq dau (polar tam 0 bk))
    (setq i 0)
    (repeat 360
    (setq ds_pt (cons dau ds_pt))
    (setq dau (polar tam (/ (* (setq i (1+ i)) pi) 180.0) bk))
    )
    (setq f 0)
    (repeat 360
    (setq pt1 (nth f ds_pt))
    (setq pt2 (nth (setq f (rem (1+ f) 360)) ds_pt))
    (grdraw pt1 pt2 1 1)
    )
    (princ)
    ) 
    ;================================================================
    ;=== ve duong bao xung quan vong tron====GRVECS==================
    (defun c:tronkhac(/ doit i tam bk d ptt ptp pdt pdp ds_ent)
    (prompt "Chon duong tron:")
    (setq doit (ssget '((0 . "CIRCLE"))))
    (if doit
           (progn
    	       (setq ofset (getvalueK ofset 0.0 "Nhap khoang offset")
                     clr (getvalueK clr 1 "Nhap mau khung")
                      i 0)
               (repeat (sslength doit)
                  (setq ds_ent (entget (ssname doit i))
    			        tam (cdr (assoc 10 ds_ent))
    					bk (cdr (assoc 40 ds_ent))
    					d (+ bk ofset)
    					ptt (mapcar '+ tam (list (- d) d))
    					ptp (mapcar '+ tam (list d d))
    					pdt (mapcar '+ tam (list (- d) (- d)))
    					pdp (mapcar '+ tam (list d (- d)))
    				)
    			 (grvecs (list clr ptt ptp ptp pdp pdp pdt pdt ptt))
    			 (setq i (1+ i))
    			 )
    		)
    )
    (princ)
    )
    ;================================
    ;=======ve duong tron ao==========GRVECS=================
    (defun c:tronkk (/ i dau clr ds_pt tam)
    (grtext -1 (strcat "Hello " (getvar 'loginname)))
      (setq tam (getpoint "\nChon tam:")
            bki (getvalueK bki 10.0 "Nhap bk: ")
      )
      (setq dau (polar tam 0 bki))
      (setq ds_pt (list 1 dau))
      (setq i 1)
      (setq clr 2)
      (repeat 359
        (setq dau (polar tam (/ (* i pi) 180.0) bki))
        (setq ds_pt (append ds_pt (list dau clr dau)))
        (setq i (1+ i))
        (setq clr (rem (1+ clr) 256))
      )
      (setq ds_pt (append ds_pt (list (polar tam 0 bki))))
      (grvecs ds_pt)
      (princ)
      (grtext)
    )
    ;==================================END C10-3=====================================
    
    

    -p/s: cái vòng tròn cuối thêm màu vô nhìn ảo dịu thật ^^

    104473_fsdft43333333333333333333333.png


  6. - hi đúng là thăng atan khó xơi, nếu cưỡng ép tính = atan của lsp thì nhoc viết vậy ^^

    
    
    (defun phuongvi(p1 p2 / deltaX deltaY p_vi)
    (setq deltaX (- (cadr p2) (cadr p1)))
    (setq deltaY (- (car p2) (car p1)))
    (cond 
     ((and (> deltaX 0) (> deltaY 0)) (setq p_vi (* (/ (atan deltaY deltaX ) pi) 180.0)))
     ((and (< deltaX 0) (> deltaY 0)) (setq p_vi (+ (* (/ (atan (abs deltaX) deltaY) pi) 180.0) 90.0)))
     ((and (< deltaX 0) (< deltaY 0)) (setq p_vi (+ 180 (* (/ (atan (abs deltaY) (abs deltaX)) pi) 180.0))))
     ((and (> deltaX 0) (< deltaY 0)) (setq p_vi (- 360.0 (* (/ (atan (abs deltaY) deltaX) pi) 180.0))))
    )
    )
    

     

    (defun phuongvi(p1 p2 / deltaX deltaY p_vi)
    (setq deltaX (- (cadr p2) (cadr p1)))
    (setq deltaY (- (car p2) (car p1)))
    (cond 
     ((and (> deltaX 0) (> deltaY 0)) (setq p_vi (* (/ (atan deltaY deltaX ) pi) 180.0)))
     ((and (< deltaX 0) (> deltaY 0)) (setq p_vi (+ (* (/ (atan (abs deltaX) deltaY) pi) 180.0) 90.0)))
     ((and (< deltaX 0) (< deltaY 0)) (setq p_vi (+ 180 (* (/ (atan (abs deltaY) (abs deltaX)) pi) 180.0))))
     ((and (> deltaX 0) (< deltaY 0)) (setq p_vi (- 360.0 (* (/ (atan (abs deltaY) deltaX) pi) 180.0))))
    )
    )

    - hơi dài dòng  :P

    • Vote tăng 1

  7. - tiện ích của bạn có phải là các file lsp ko ^^, nếu vậy bạn vô phần custom của cad dò đến các tên lệnh bạn tạo như wedding 1 chẳng hạn

    104473_ddddddddddddddddd.png

     

    - như khung bên phải là wedding của bạn chỗ mũi tên,khung bên trái chổ mũi tên sau dòng mặc định ^C^C.....: bạn sẽ điền tên lệnh chạy lsp nao đó của bạn ^^

    • Vote tăng 1

  8. - hàng này của thầy Ket đây mà ^^, nhoc nghịch tí ^^

    ;;--------------------------------------
    (defun _layer2 ( name colour )
        (if (null (tblsearch "LAYER" name))
            (entmake
                (list
                   '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   '(70 . 0)
                    (cons 2 name)
                    (cons 62 colour)
                )
            )
        )
    )
    ;================================
    (defun c:trb(/ p1 p11 p2 p22 n1 x1 x2 dis1 dis2 i oldOs oldCmd oldclay)
    (grtext -1 "@S\U+01A1n T\U+00F9ng - ketxu - Cadviet")
    (if (null (tblsearch "layer" "danhbong")) (_layer2 "danhbong" 8)) 
    (if (= n nil)(setq n 10))
    (setq p1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m 1") 
    p2 (getpoint p1 "\nCh\U+1ECDn \U+0111i\U+1EC3m 2") 
    p11 (getpoint  "\nCh\U+1ECDn \U+0111i\U+1EC3m 3") 
    p22 (getpoint p11 "\nCh\U+1ECDn \U+0111i\U+1EC3m 4") i 0
    n1 (getint (strcat "\nS\U+1ED1 kho\U+1ea3ng chia < " (rtos n 2 0) " > : "))
    	dis1 (distance p1 p11)
    	dis2 (distance p2 p22)
    )
    (if n1 (setq n n1))
    (setq
    x1 (/ dis1  (/ (* n (+ n 1)) 2))
    x2 (/ dis2  (/ (* n (+ n 1)) 2))
    oldOs (getvar "osmode")
    oldCmd (getvar "cmdecho")
    oldclay (getvar 'clayer))
    
    (setvar "osmode" 0)
    (setvar "cmdecho" 0)
    (setvar 'clayer "danhbong")
    (repeat n
    	(command ".Line" (setq p1 (polar p1 (angle p1 p11) (+ x1 (* i x1)))) (setq p2(polar p2 (angle p2 p22) (+ x2 (* i x2)))) "")
    	(setq i (1+ i))
    )
    (setvar "osmode" oldOs)
    (setvar "cmdecho" oldCmd)
    (setvar 'clayer oldclay)
    (princ)
    )
    
    • Vote tăng 1

  9. - anh Ket nộp toàn bộ bài tập C10-2, ko pit còn thiếu sót gì ko ^^

    ; 1- an doi tuong
    (defun c:khide(/ i )
    (prompt "Ch\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+00FAn \U+1EA9n:")
    (setq doit (ssget))
    (if doit
    (progn
    (setq i 0)
    (repeat (sslength doit)
     (setq ent (ssname doit i))
     (redraw ent 2)
     (setq i (1+ i))
     )
     )
     )
     )
    ;========================== hien doi tuong =================================
    (defun c:khien (/ i)
    (if doit
    (progn
    (setq i 0)
    (repeat (sslength doit)
     (setq ent (ssname doit i))
     (redraw ent 1)
     (setq i (1+ i))
     )
     )
     )
     )
    ;===========================================an nhieu nhom doi tuong=================
    (defun c:khides(/ i ss2ent doit)
    ;=====================================================
    (defun ss2ent (ss / i Le e) 
    (setq i 0)
    (repeat (sslength ss)     
    (setq e (ssname ss i)        
    Le (append Le (list e))        
    i (1+ i)    ))
    Le)
    ;====================================================
    (prompt "Ch\U+1ECDn l\U+1EA7n l\U+01B0\U+1EE3t c\U+00E1c nh\U+00F3m \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+00FAn \U+1EA9n: ")
    (setq doit (ssget))
    (if doit
    (progn
    (setq i 0)
    (setq lst_ent (ss2ent doit))
    (setq nhom_hide (append lst_ent nhom_hide))
    (repeat (length lst_ent)
     (setq ent (nth i lst_ent))
     (redraw ent 2)
     (setq i (1+ i))
     )
     )
     )
     )
    ;===========================hien lai nhieu nhom doi tuong===============================
    (defun c:khiens (/ i nhom_hide doit)
    (if nhom_hide
    (progn
    (setq i 0)
    (repeat (length nhom_hide)
     (setq ent (nth i nhom_hide))
     (redraw ent 1)
     (setq i (1+ i))
     )
     )
     )
     )
     ;==================================
     ;==================
    (defun K:redraw (ss ma / i ent)
    (setq i 0)
    (repeat (sslength ss)     
    (setq ent (ssname ss i))
    (redraw ent ma)        
    (setq i (1+ i))     
    )
    )
    ;=========================xoa tat ca doi tuong tren man hinh, de lai dong text  sau do nhap please de hien lai==============
    (defun c:ktroll (/ doit str)
    (vl-load-com)
    (setvar 'cmdecho 0)
    ;==================
    (defun K:redraw (ss ma / i ent)
    (setq i 0)
    (repeat (sslength ss)     
    (setq ent (ssname ss i))
    (redraw ent ma)        
    (setq i (1+ i))     
    )
    )
    ;===========================
    ;=====================================
    (setq doit (ssget "X"))
    (if doit
    (progn
       (K:redraw doit 2)
       (vl-cmdf ".text" '(0 0) (getvar "textsize") 0 "Ban ve cua ban da bi xoa het ^^")
       (vl-cmdf ".zoom" "o" "last" "")
       )
     )
    ;==============================================
    (while (or (not str) (/= str "Vuilong"))
    (setq str (getstring "\nB\U+1EA1n nh\U+1EADp \U+0111\U+00FAng t\U+1EEB \"Vuilong\" \U+0111\U+1EC3 tr\U+1EA3 l\U+1EA1i vi\U+1EC7c \U+0111ang l\U+00E0m: ")))
    (if (= str "Vuilong")
    (progn
    (vl-cmdf ".erase" "last" "")
    (K:redraw doit 1)
    (vl-cmdf ".zoom" "e")
    )
    )
    (setvar 'cmdecho 1)
    (princ)
    )
    
    ;========================================================
    ;=================bai nhap nhay doi tuong=============
    (defun c:chopchop(/ doit xnhay vnhay trove)
    (vl-load-com)
    (setvar 'cmdecho 0)
    (setq doit (ssget))
    (if doit
    (progn
    (setq xnhay (getint "\nNhap so lan nhay:"))
    (setq vnhay (getint "\nNhap so lan nhay bao nhieu lan / 1s :"))
    (repeat xnhay
    (K:redraw doit 2)
    (vl-cmdf "delay" (/ 500 vnhay))
    (K:redraw doit 1)
    (vl-cmdf "delay" (/ 500 vnhay))
    )
    (textscr)
    (princ (strcat "so doi tuong da chon chop chop : " (itoa (sslength doit))))
    (princ "\n")
    (princ (strcat "thoi gian chay la : " (rtos (/ (* xnhay 2 (/ 500 vnhay)) 1000.0) 2 1) " giay"))
    (princ "\n")
    (setq trove (getstring "\nBan nhap phim bat ky or enter de tro ve man hinh chinh :"))
    (if trove 
    (graphscr))
    )
    )
    (setvar 'cmdecho 1)
    (princ)
    )
    ;===============================
    ;1- ham lay ten cac phan tu trong 1 tab
    (defun K:dsbg (table / lst phu)
    (tblnext table t)
    (while (setq phu (tblnext table nil))
    (setq lst (cons (cdr (assoc 2 phu)) lst))
    )
    )
    ;===================================
    (defun K:get (table ten)
    (entget (tblobjname table ten))
    )
    ;==================================
    ; 3 - bat tat layer
    (defun K:btlay(tenlayer / phu)
    (setq phu (K:get "layer" tenlayer))
    (entmod (subst (cons 62 (* -1 (cdr (assoc 62 phu)))) (assoc 62 phu) phu))
    )
    ;===============================bai hightlight tat ca doi tuong tru layer 0=================
    (defun c:khl (/ doit ds_lay ds_layoff lay_off)
    (vl-load-com)
    (setvar 'cmdecho 0)
    (vl-cmdf ".zoom" "e")
    (setq doit (ssget "X" '((8 . "~0"))))
    (if doit
     (progn
     
    ;==========================================
    (setq ds_lay (K:dsbg "layer"))
    (foreach x ds_lay
    (if (< (cdr (assoc 62 (K:get "layer" x))) 0)
    (progn
    (setq lay_off x)
    (setq ds_layoff (cons lay_off ds_layoff)))
    )) ;end foreach ds_lay
    ;==========================
    (foreach k ds_layoff
    (K:btlay k))
    (K:redraw doit 3)
    (while (or (not str) (/= str "")) (setq str (getstring "\nBan nhan Enter de tro ve trang thai cu :")))
    (if (= str "")
    (progn
    (foreach d ds_layoff
    (K:btlay d))
    (K:redraw doit 4)
    )
    )
    ;======================================================================
    )
    )
    (setvar 'cmdecho 1)
    (princ)
    )
    
    
    
    
    
    

    -p/s: nhân dịp 20/11 nhoc chúc anh Ket sức khỏe , công việc suôn sẻ, đặc biệt sớm kím đc .....^^, để hết stt "Cô đơn"  :P

    • Vote tăng 1

  10. Thầy ketxu ơi, trong lý thuyết có phần:

    Dấu_ trước tên lệnh dùng để gọi lệnh gốc phiên bản tiếng Anh.

    Dấu . trước tên lệnh dùng để gọi lệnh nguyên thuỷ, bất kể lệnh đó đã bị redefine hay không.

     

    Phần này em vẫn còn lơ mơ thầy có thể giải thích kỹ hơn được không, redefine là gì và cả lệnh gốc phiên bản tiếng Anh nữa. Em dùng _Line hay .Line đều thấy kết quả giống nhau, 2 thằng này khác nhau cơ bản như thế nào?.

     

    Ở hai ví dụ cuối cùng :

    (command ".line" "0,0" (1,1) "2,2" "") ---> ở đây cad không hiểu (1,1) là một điểm, nó báo lỗi luôn.

    (command ".line" "0,0" "1,1" ".circle " "1,1" 2)==> Cad vẫn hiểu mà không cần cho vào dấu ngoặc kép.

     

    Vậy khi nào thì mình có thể "xí xóa" được dấu " " này thế thầy. Vì nguyên tắc là tất cả các giá trị nhập từ bàn phím đều phải cho vào trong dấu " ".

    :D

    - cái phần gốc với nguyên thủy nhoc cũng hơi mơ hồ ^^, tóm lại là khi code lsp có dùng command Hieu cứ thêm _ or . cho chắc ăn, ko lo bị lỗi lệnh ^^

    - còn lệnh Hieu để ý khi dùng trong cad với line thì điểm thứ nhất mình có thể pick hay nhập tọa độ, mà tọa độ nhập ờ đây sẽ là dạng chuỗi nên phải để trong "" hoặc dạng danh sách tọa độ x y z tối thiếu phải có x y ko có z cũng đc với 2d

    - cad sẽ tự biên dịch lại thành tọa độ điểm, như Hieu viết (1,1) nó hiểu là dạng chuỗi như ko đúng luật ^^ nên nó ko dịch lại thành tọa độ đc, trừ khi viết như vậy thì nó hiểu (list 1 1) do đúng dạng tọa độ là 1 danh sách gồm x và y, Vinh thử xem 1 biến pt bất kỳ mà mình pick nó là dạng dữ liệu danh sách như thế này (5 5 0.0)

    - còn khi nào có hay ko "" thì để ý khi test command trên cad, nó đòi dạng dữ liệu nhập là gì, như chiều cao hay góc xoay, bán kính thì là số thực or nguyên, lúc đó ko cần ""

    • Vote tăng 1

  11. - hi hnay đc thong thả xíu nhoc làm vài bài đầu mong đc anh Ket và các bạn góp ý có sai sót chỗ nào ko, góp ý giúp nhoc ^^

    ; 1- an doi tuong
    (defun c:khide(/ i )
    (prompt "Ch\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+00FAn \U+1EA9n:")
    (setq doit (ssget))
    (if doit
    (progn
    (setq i 0)
    (repeat (sslength doit)
     (setq ent (ssname doit i))
     (redraw ent 2)
     (setq i (1+ i))
     )
     )
     )
     )
    ;========================== hien doi tuong =================================
    (defun c:khien (/ i)
    (if doit
    (progn
    (setq i 0)
    (repeat (sslength doit)
     (setq ent (ssname doit i))
     (redraw ent 1)
     (setq i (1+ i))
     )
     )
     )
     )
    ;===========================================an nhieu nhom doi tuong=================
    (defun c:khides(/ i ss2ent doit)
    ;=====================================================
    (defun ss2ent (ss / i Le e) 
    (setq i 0)
    (repeat (sslength ss)     
    (setq e (ssname ss i)        
    Le (append Le (list e))        
    i (1+ i)    ))
    Le)
    ;====================================================
    (prompt "Ch\U+1ECDn l\U+1EA7n l\U+01B0\U+1EE3t c\U+00E1c nh\U+00F3m \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+00FAn \U+1EA9n: ")
    (setq doit (ssget))
    (if doit
    (progn
    (setq i 0)
    (setq lst_ent (ss2ent doit))
    (setq nhom_hide (append lst_ent nhom_hide))
    (repeat (length lst_ent)
     (setq ent (nth i lst_ent))
     (redraw ent 2)
     (setq i (1+ i))
     )
     )
     )
     )
    ;===========================hien lai nhieu nhom doi tuong===============================
    (defun c:khiens (/ i)
    (if nhom_hide
    (progn
    (setq i 0)
    (repeat (length nhom_hide)
     (setq ent (nth i nhom_hide))
     (redraw ent 1)
     (setq i (1+ i))
     )
     )
     )
     )
    ;=========================xoa tat ca doi tuong tren man hinh, de lai dong text  sau do nhap please de hien lai==============
    (defun c:ktroll (/ doit xoahet tralai str)
    (vl-load-com)
    (setvar 'cmdecho 0)
    ;==================
    (defun xoahet (ss / i ent)
    (setq i 0)
    (repeat (sslength ss)     
    (setq ent (ssname ss i))
    (entdel ent)        
    (setq i (1+ i))     
    )
    )
    ;===========================
    (defun tralai (ss / i ent)
    (setq i 0)
    (repeat (sslength ss)     
    (setq ent (ssname ss i))
    (entdel ent)        
    (setq i (1+ i))     
    )
    )
    ;====================================
    ;=====================================
    (setq doit (ssget "X"))
    (if doit
    (progn
       (xoahet doit)
       (vl-cmdf ".text" '(0 0) (getvar "textsize") 0 "Ban ve cua ban da bi xoa het ^^")
       (vl-cmdf ".zoom" "e")
       )
     )
    ;==============================================
    (while (or (not str) (/= str "Vuilong"))
    (setq str (getstring "\nB\U+1EA1n nh\U+1EADp \U+0111\U+00FAng t\U+1EEB \"Vuilong\" \U+0111\U+1EC3 tr\U+1EA3 l\U+1EA1i vi\U+1EC7c \U+0111ang l\U+00E0m: ")))
    (if (= str "Vuilong")
    (progn
    (vl-cmdf ".erase" "last" "")
    (tralai doit)
    (vl-cmdf ".zoom" "e")
    )
    )
    (setvar 'cmdecho 1)
    (princ)
    )
    
    ;========================================================
    
    
    
    
    
    
    
    
×