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. - hi mấy lsp dạng này trên 4rum mình nhiều lắm, tết rãnh nhoc luyện viết thử xem ^^

    
    
    ;; free lisp from cadviet.com
    ;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/119469-nho-viet-lisp-xuat-du-lieu-ra-file-excel/
    (defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
    (setq i 0)
    (repeat (sslength ss)     
    (setq e (ssname ss i)        
    Le (append Le (list e))        
    i (1+ i)    ))
    Le)
    ;=================================================================================
    (defun Length1(e) 
    (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
    ;=======================================================================
    (defun c:kko (/ ss ds_ent ds_laydis layer dis info)
    (prompt "Quet chon cac Multiline ")
    (setq ss (ssget '( (0 . "MLINE"))))
    (if ss 
    	(progn 
    		(setq ds_ent (ss2ent ss))
    			(foreach k ds_ent
    				(setq info (entget k))
    				(setq layer (acet-dxf 8 info))
    				(setq dis (add_mline info))
    				(setq ds_laydis (append ds_laydis (list (list layer dis))))
    			)
    		)
    )
    (xls ds_laydis '("LAYER" "CHIEU DAI") nil "Thong ke")
    ;(princ ds_laydis)
    (princ)
    )
    ;==============================================================================================================================================
    (vl-load-com)
    (defun xls (Data-list	   header	  Colhide	 Name_list
    	    /		   *aplexcel*	  *books-colection*
    	    Currsep	   *excell-cells* *new-book*	 *sheet#1*
    	    *sheet-collection*		  col		 iz_listo
    	    row		   cell		  cols
    	   )
      (defun Letter	(N / Res TMP)
        (setq Res "")
        (while (> N 0)
          (setq TMP	(rem N 26)
    	    TMP	(if (zerop TMP)
    		  (setq	N   (1- N)
    			TMP 26
    		  )
    		  TMP
    		)
    	    Res	(strcat (chr (+ 64 TMP)) Res)
    	    N	(/ N 26)
          )
        )
        Res
      )
      (if (null Name_list)
        (setq Name_list "")
      )
      (setq *AplExcel* (vlax-get-or-create-object "Excel.Application"))
      (if (setq *New-Book* (vlax-get-property *AplExcel* "ActiveWorkbook"))
        (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
    	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
    	  *Sheet#1*	     (vlax-invoke-method *Sheet-Collection* "Add")
        )
        (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
    	  *New-Book*	     (vlax-invoke-method *Books-Colection* "Add")
    	  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
    	  *Sheet#1*	     (vlax-get-property *Sheet-Collection* "Item" 1)
        )
      )
      (setq *excell-cells* (vlax-get-property *Sheet#1* "Cells"))
      (setq	Name_list (if (= Name_list "")
    		    (vl-filename-base (getvar "DWGNAME"))
    		    (strcat (vl-filename-base (getvar "DWGNAME"))
    			    "&"
    			    Name_list
    		    )
    		  )
    	col	  0
    	cols	  nil
      )
      (if (> (strlen Name_list) 26)
        (setq Name_list
    	   (strcat (substr Name_list 1 10)
    		   "..."
    		   (substr Name_list (- (strlen Name_list) 13) 14)
    	   )
        )
      )
      (vlax-for sh *Sheet-Collection*
        (setq cols (cons (strcase (vlax-get-property sh 'Name)) cols))
      )
      (setq row Name_list)
      (while (member (strcase row) cols)
        (setq row (strcat Name_list " (" (itoa (setq col (1+ col))) ")"))
      )
      (setq Name_list row)
      (vlax-put-property *Sheet#1* 'Name Name_list)
      (setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
      (vlax-put-property
        *AplExcel*
        "UseSystemSeparators"
        :vlax-false
      ) ;_?? ???????????? ????????? ?????????
      (vlax-put-property *AplExcel* "DecimalSeparator" ".") ;_??????????? ??????? ? ????? ?????
      (vlax-put-property *AplExcel* "ThousandsSeparator" " ") ;_??????????? ???¤???
      (vla-put-visible *AplExcel* :vlax-true)
      (setq	row 1
    	col 1
      )
      (if (null header)
        (setq header '("X" "Y" "Z"))
      )
      (repeat (length header)
        (vlax-put-property
          *excell-cells*
          "Item"
          row
          col
          (vl-princ-to-string (nth (1- col) header))
        )
        (setq col (1+ col))
      )
      (setq	row 2
    	col 1
      )
      (repeat (length Data-list)
        (setq iz_listo (car Data-list))
        (repeat (length iz_listo)
          (vlax-put-property
    	*excell-cells*
    	"Item"
    	row
    	col
    	(vl-princ-to-string (car iz_listo))
          )
          (setq iz_listo (cdr iz_listo)
    	    col	     (1+ col)
          )
        )
        (setq Data-list (cdr Data-list))
        (setq col 1
    	  row (1+ row)
        )
      )
      (setq	col (1+ (length header))
    	row (1+ row)
      )
      (setq	cell (vlax-variant-value
    	       (vlax-invoke-method
    		 *Sheet#1*
    		 "Evaluate"
    		 (strcat "A1:" (letter col) (itoa row))
    	       )
    	     )
      ) ;_ end of setq
      (setq cols (vlax-get-property cell 'Columns))
      (vlax-invoke-method cols 'Autofit)
      (vlax-release-object cols)
      (vlax-release-object cell)
      (foreach item	ColHide
        (if	(numberp item)
          (setq item (letter item))
        )
        (setq cell (vlax-variant-value
    		 (vlax-invoke-method
    		   *Sheet#1*
    		   "Evaluate"
    		   (strcat item "1:" item "1")
    		 )
    	       )
        )
        (setq cols (vlax-get-property cell 'Columns))
        (vlax-put-property cols 'hidden 1)
        (vlax-release-object cols)
        (vlax-release-object cell)
      )
      (vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
      (mapcar 'vlax-release-object
    	  (list	*excell-cells*	    *Sheet#1*
    		*Sheet-Collection*  *New-Book*
    		*Books-Colection*   *AplExcel*
    	       )
      )
      (setq *AplExcel* nil)
      (gc)
      (gc)
      (princ)
    )
    ;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    ;http://www.cadviet.com/forum/topic/763-routine-tinh-tong-chieu-dai-cac-doi-tuong/
    (defun add_mline ( elist / pt1 mline_len pt2 tot_len)
    (setq tot_len 0.0)
      (foreach k	elist
        (cond ((= 10 (car k))
    	   (setq pt1	   (cdr k)
    		 mline_len 0.0
    	   )
    	  )
    	  ((= 11 (car k))
    	   (setq pt2	   (cdr k)
    		 mline_len (+ mline_len (distance pt2 pt1))
    		 pt1	   pt2
    	   )
    	  )
        )
      )
      (setq tot_len (+ tot_len mline_len))
     )
    

  2. - ngón này nhoc ko rành lắm, nhoc thử sữa lại theo ý bạn, bạn xem có đúng ko ^^, nhoc chỉ sợ lượt bớt nhiều quá làm sai kết quả ^^

    (defun DXFcn (code elist) (cdr (assoc code elist)))
    ;============================================================
    (prompt "\n[Cmd:CDX] - GHI CAO DO DIEM TREN TRAC NGANG by Thaistreetz - huuthais@yahoo.com\n")
    ;============================================================
    (defun c:Cdx (/ DZ pt  ptside ang OT sc1 scale tx ty tx1 ty1 y H0) ; 
    (command "Undo" "BEGIN")
    (if (= tx nil) 
    	(setq tx 1))
    (if (= ty nil) 
    	(setq ty 1))
    	(setq 		  tx1 (getreal (strcat "\nTy le theo phuong X <1/"(rtos tx 2 2)">: 1/")) 
    		  ty1 (getreal (strcat "\nTy le theo phuong Y <1/"(rtos ty 2 2)">: 1/"))
    	)
    (if tx1 (setq tx tx1))
    (if ty1 (setq ty ty1))
    (setq ATLAST (getvar "Attreq"))
    (setq CMLAST (getvar "cmdecho"))
    (setq OSLAST (getvar "OSMODE"))
    (setq DZ (getvar "DIMZIN"))
    (setq OT (getvar "ORTHOMODE"))
    (setvar "ORTHOMODE" 0)
    (setvar "cmdecho" 0)
    (command "osmode" 99)
    (setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
    (setq x0 (car pt0) y0 (cadr pt0))
    ;(setvar 'osmode 0)
    (setq ed (entget (car (entsel "\nChon cao do tim: "))))
    (setq H0 (read (DXFcn 1 ed))) 
    (While (and (setq pt (getpoint "\nChon diem chuan : ")) (setq doitt (car (entsel "\nChon text de chinh sua: "))))
    (Progn
    	(setq y (- (cadr pt) y0 (- H0)))
    (cond 
    	((> y 0) (entmod (subst (cons 1 (strcat "+" (rtos (* y ty) 2 2))) (assoc 1 (entget doitt)) (entget doitt))))
    	((< y 0) (entmod (subst (cons 1 (rtos (* y ty) 2 2)) (assoc 1 (entget doitt)) (entget doitt)))) 
    	((= y 0) (entmod (subst (cons 1 "%%p0.00") (assoc 1 (entget doitt)) (entget doitt))))
    )
    
    );progn
    );while 
    (setvar "OSMODE" OSLAST)(setvar "ORTHOMODE" OT)(setvar "cmdecho" CMLAST)
    (prompt "\n[GHI CAO DO TRAC NGANG] by Thaistreetz - huuthais@yahoo.com\n")
    (command "Undo" "End")
    (princ)
    );end
    
    • Vote tăng 1

  3. - hi mấy anh cho nhoc hỏi ngoài lề xíu ^^, tốc độ thực thi của Lsp phụ thuộc vào phiên bản cad hay cấu hình máy tính nhỉ, đó giờ nhoc cũng nghi vấn nhưng chưa test thử, nay bùn bùn test thử ^^

    - cùng 1 lsp nhoc test trên lap nhoc hay làm core i5 cad2014 tạo khoảng 5k đối tượng (lsp này nhoc chỉ dùng vòng lặp với entmake) mất 4 phút mới chạy xong.

    - chạy thử trên máy bàn của thằng em cũng core i5 cad2015 tạo như trên chỉ mất gần 1 phút ^^

    - tuy cùng core i5 nhưng chưa chắc thằng nào mạnh hơn ^^ nhoc nghĩ còn phụ thuộc nhiều yếu tố khác, về khoảng xem cấu hình máy nhoc chưa pit nhiều ^^

    -p/s: mấy anh mod thấy nhoc lạc đề move hộ nhoc hen ^^


  4. - hi lsp nhoc sữa lại cho phép chạy hàng loạt, bằng cách quét chọn các line theo như bản vẽ mẫu của bạn, cách thức của nhoc là lấy tọa độ giao điểm rùi xét từ tọa độ đó xung quang có 2 text đó ko nếu có sẽ tính ra cao độ vẽ point có cao độ, còn nếu ko có text nó vẫn vẽ lấy tọa độ giao điểm lúc đầu chưa add Z , trong file của bạn hàng cuối ko có text ^^, còn nếu ko mún vẽ khi quét chọn bạn né đường line cuối ra đừng chọn ^^.

    - bạn mún xử 22k điểm chắc sợ không nổi như nhoc test khoảng 3k điểm là cad mún đơ rùi ^^, nhưng vẫn ráng đc, nên bạn chia nhỏ mà chạy, cái này nhoc chưa nghiên cứu ko pit khả năng xử lý của cad có liên quan đến khả năng của máy ko, nếu máy bạn mạnh thử test chèn 5k điểm xem ^^

    (defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
    (setq i 0)
    (repeat (sslength ss)     
    (setq e (ssname ss i)        
    Le (append Le (list e))        
    i (1+ i)    ))
    Le)
    ;================================================================
    (defun Intersk (e1 e2 / ob1 ob2 g L i kq)(vl-load-com)
    (setq ob1 (vlax-ename->vla-object e1)
        ob2 (vlax-ename->vla-object e2)    
    	g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
    	(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
    	(setq i 0)
    	(repeat (/ (length L) 3)    
    	(setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))    
    	(setq i (+ i 3)))
    	kq)
    ;=================================================================
    (defun c:kkl (/  *error*   ds_line old ss1 te1 te2 Lp cao_do ptn ss pcuoi pdau ssk )
    ;===================================================================
     (defun *error* ( msg )
            (if old (setvar 'osmode old))
            (if (not (member msg '("Function cancelled" "quit / exit abort")))
                (princ (strcat "\nError: " msg))
            )
            (princ)
        )
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq old (getvar 'osmode))
    (setvar 'osmode 0)
    (prompt "Chon cac doi tuong la Line : ")
    (setq ss (ssget '((0 . "LINE"))))
    (if ss
    (progn 
    ;=========================
    (setq ds_line (ss2ent ss))
    ;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    (repeat (1- (length ds_line))    
    	(setq ds_line (vl-remove (setq e0 (car ds_line)) ds_line))    
    	(foreach e ds_line (setq Lp (append Lp (intersk e0 e)))) 
    	)
    ;===================================================
    
    ;/////////////////////////////////////////////////////////
    (foreach k Lp
    (setq pdau (mapcar '+ k '(2.35 2.35 0.0)) pcuoi (mapcar '+ k '(-2.35 -2.35 0.0)))
    (if  (setq ssk   (ssget "_C" pcuoi pdau '((0 . "TEXT"))))
    (progn
    (setq ss1 (ss2ent ssk))
    (foreach u ss1
    (if (= (cdr (assoc 8 (entget u))) "S-BGD-HICN-H27")     (setq te1 (distof (cdr (assoc 1 (entget u))))))
    (if (= (cdr (assoc 8 (entget u))) "S-BGD-LWCN-H27")     (setq te2 (distof (cdr (assoc 1 (entget u))))))
    )
    ;======================================================================
    ;=======================================================================
    (setq cao_do  (- (* te1 -1) (/ te2 10.0)))
    (setq ptn (subst cao_do (last k) k))
    (K_point ptn "cao_do" 3)
    )
    (K_point k "cao_do" 3)
    )
    )
    ;====================
    ) ; end progn ss
    ) ; end if ss
    (setvar 'osmode old)
    (princ "Xong")
    (princ)
    )
    ;===========================================
    (defun K_point (pt layer clr / lst)
    (setq lst (list '(0 . "POINT")
            '(100 . "AcDbEntity") 
            (cons 8 (if Layer Layer (getvar "Clayer")))
    		    (cons 62 (if clr clr 256))
    			  '(100 . "AcDbPoint")
    			  (cons 10 pt)))
    (entmakex lst)
    )
    
    
    
    
    
    
    
    

    -p/s: ah còn định dạng point bạn tự định dạng trước khi chạy hen ^^

    • Vote tăng 1

  5. - ý bạn phải vậy hem ^^

    (defun c:kkl (/ te1 te2 pt *error* dxf1 dxf2)
    ;===================================================================
     (defun *error* ( msg )
            (if (not (member msg '("Function cancelled" "quit / exit abort")))
                (princ (strcat "\nError: " msg))
            )
            (princ)
        )
    ;==================================================================
     (while (and (setq te1 (car (entsel "\nChon text 1"))) (setq te2(car (entsel "\nChon text 2")))
    (setq pt (getpoint "\nChon diem dat point :")))
    ;/////////////////////////////////
    (setq dxf1 (cdr (assoc 1 (entget te1))) dxf2 (cdr (assoc 1 (entget te2))))
    (setq caodo (- (* (distof dxf1) -1) (/ (distof dxf2) 10.0)))
    (setq pt (subst caodo (last pt) pt))
    (entmake (list
    			(cons 0 	"POINT")
    			(cons 100 	"AcDbPoint")
    			(cons 10	pt)
    			))
    )
    (princ)
    )
    
    • Vote tăng 1

  6. - nhoc xin góp vui tý thêm 1 phương án cho chủ pic ^^

    
    (defun C:mt( / cc in ls dai p1 p2 q2 cao_chu lstp)
    (vl-load-com)
    ;================================================================
     ;==================================================================
    (setq clr (getvar 'cecolor)  echo (getvar 'cmdecho))
       (setvar "CECOLOR" "Cyan")
         (setvar 'cmdecho 0)
    	(setq in (getvalue in 1  "Choose the first number ")
    	)
    (setq cao_chu (getvalue cao_chu 2.2 "Nhap chieu cao text "))
    
    
      (While  (/= (setq cc (getpoint "\nSpecify center point for rectang: "))  nil) 
    	
    	(command ".text" "M" "NON" cc cao_chu 0 (them0 (itoa in)))
    	(setq lstp (vla-getBoundingBox (vlax-ename->vla-object (cdr (assoc -1 (entget (entlast))))) 'minp 'maxp))
    	(setq p1 (mapcar '+ (vlax-safearray->list minp) '(-0.35 -0.35 0.0)))
        (setq p2 (mapcar '+ (vlax-safearray->list maxp)  '(0.35 0.35 0.0)))
        (command ".rectang" "non" p1 "non" p2)
    	(setq
    		q2 (list (car cc) (- (cadr cc) (* 0.75 cao_chu)))
    		ls (getpoint q2 "\nChoose point on joint ")        
    	)
    	(command     "qleader" ls q2 nil)
    
      ^C ^C;
     (setq in  (1+ in)) 
     
        ); end while
     (setvar "CECOLOR" clr)
        (setvar 'cmdecho echo)
      (princ)
    );
    ; ham luu gia tri
    (defun getvalue ( a giatri dongnhac / astr) 
    (or a (setq a giatri))
    (cond
    	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
    	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 2) ") :")))(a))))
    	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring 1 (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
    ))
    ;;;;
    (defun them0(chuoi)
      (setq len (strlen chuoi))
      (if (= len 1)
        (strcat "00" chuoi)
        (if (= len 2)
          (strcat "0" chuoi)
          chuoi
        )  
      )
     )
    
    • Vote tăng 1

  7. (defun H_tamgiacdeu (..... / ....)
    (setq lst (list ......))
    (entmakex lst)
    ) 

    - như mấy bài vẽ hình tam giác đều, hình vuông, hình chữ nhật ấy ^^, đúng là tận dụng thì đỡ nhọc hơn nhiều, nhoc chỉ nói vui cũng để luyện thằng entmake

    - trường hợp khác nếu tạo độc lập thì khi dùng cũng đỡ 1 ít ko phải lôi theo cả hảm H:Pline theo ^^, như nhoc thì hay dùng entmakex ngoài việc tạo đối tượng ra nó còn trả về ename của đối tượng, để khi cần có thể lôi đối tượng đó ra lại nhằm mục đích gì đó, đỡ phải mò lại nó ^^

    - 1 ít kinh nghiệm nhoc chia sẽ, còn lại  do sở thích và quan điểm của người viết ^^


  8. - hi nhoc cũng mới thử code nhanh theo ý tưởng của bạn, bạn tham khảo ^^

    (defun C:tinhcd(/ c ename info cong chia ds_cong ds_ent num)
    (setq c -1 )
    (if (setq ss (ssget '((0 . "TEXT"))))
     (progn
        (while (setq ename (ssname ss (setq c (1+ c))))
          (if (setq num (distof (cdr (assoc 1 (entget ename)))))
    	      
              (setq ds_ent (append ds_ent (list ename)))
          );if
    	  ds_ent
    	);while, vong while dùng de kiem tra cac text dang so, neu la dang so thi gom cac ename do vao 1 danh sach
    ;//////////////////////////////////////////////////////////////////	
    (if ds_ent
    (progn
    (foreach k ds_ent
    (if (= (cdr (assoc 8 (entget k))) "TEXT2")
       (setq info (entget k))
       ) ; if nay de loc lay elist cua text mau xanh can entmod
    ;///////////////////////////////////////////
    (if (= (cdr (assoc 8 (entget k))) "TEXT1")
       (setq chia (distof (cdr (assoc 1 (entget k)))))
       ) ; if nay dung de loc texst mau vang dat sau do lay gia tri cua no ra
    ;////////////////////////////////////////////
    (if (= (cdr (assoc 8 (entget k))) "TEXT3")
     (progn
       (setq cong (distof (cdr (assoc 1 (entget k)))))
       (setq ds_cong (append ds_cong (list cong)))
       )
       )
     ) ; if nay de loc cac text mau do gom cac gia tri cua no vao 1 danh sach
    (entmod (subst (cons 1 (rtos (/ (apply '+ ds_cong) chia) 2 2))   (assoc 1 info) info))
    )  
    )
      );progn
      (alert "\nChua co doi tuong dc chon hoac ban chi chon toan text chu ^^")
    );if    
    (princ)
    )
    
    
    • Vote tăng 1

  9. - nếu bạn đang luyện thì có thể tham khảo thử cách của nhoc như thể này ^^.

    - quét hết các text bạn mún, sau đó lọc ra các text theo từng layer ra từng danh sách khác nhau.

    - có danh sách text màu đỏ lấy dxf1 ra rùi cộng với nhau, chia cho dxf1 của text màu đất cuối cùng entmod text màu xanh

    - nhoc nghĩ cái sườn  là vậy ^^, còn lại tùy bạn ứng biến

    p/s: lưu ý nếu kỹ thì nên thêm đk chỉ nhận các text là dạng số ^^

    • Vote tăng 1

  10. - sữa lại tí phụ anh P, bạn thử xem

    ;; free lisp from cadviet.com
    ;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/12225-xin-lisp-xuat-toa-do/page-3
    ;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
    ----------------------------------------------
    (defun textM (pt height string / lst) 
    (setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 0) (cons 72 4) (cons 11 pt) (cons 7 (getvar "Textstyle"))))
    (entmakeX Lst)  )
    (defun C:td (/ diem PT1 PT2 tapx tapy obj ss
    		   x y xx yy h n di kc ten k
    		   C PT PTX PTY PTD PTC N
    		   p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
    (setvar "cmdecho" 0 )
    (command "Undo" "Begin")  
      (setq om (getvar "osmode"))
      (setq tapx '()
    	tapy '()
    	stt '()
    		h (getreal "\nNhap chieu cao chu:")
    	ten (getstring "\nNhap ten diem:"))
    	(initget 1)
    	(setq k  (getint "\nNhap so thu tu diem:"))
    (while
      (setq diem (getpoint "\nChon cac vi tri co toa do can ghi:"))
    	(setq   PT1 (getpoint diem "Nhap diem thu 2") 
    		 x (rtos(car diem) 2 4)
    			 y (rtos (cadr diem) 2 4)
    	   tapx (append tapx (list x))
    	   tapy (append tapy (list y))
    		 		 N (strcat ten (itoa k))
    		stt (append stt (list N))	  );setq
    (if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
      (setvar "osmode" 0)
    (setq obj (textM pt1 h x)) (setq ss (entlast)) 
    ;(command "text" "j" "BL" PT1 h 0 x)
    (setq TB (textbox (entget ss)) 
    LC (car TB) RC (cadr TB) di (distance LC RC) C PT1);setq
    (command "erase" ss "" "pline" diem pt2 ""
    		 "circle" C (* 1.8 h))
    		 (textM C h N) 
    	(setvar "osmode" om)	
    (setq k (1+ k))	
    	);dong while
    ;tao bang thong ke
    (setq	kc (* 2 di)
    	PT (getpoint"\nvi tri dat bang :")
    	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
    	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
    	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
    	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
    	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
    	PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
    	PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
    	PTY (list (+ kc (car PTX)) (cadr PTX))
    	  p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
    	  p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
    	  p33 (list (+ kc (car p22)) (cadr p22))
    	  L1 (list (+ di (car p3))(cadr p3))
    	  L2 (list (+ kc (car L1))(cadr L1))
    	 n (length tapx)
    	 k 0);setq
    (setvar "osmode" 0)
      (command "line" p1 p2 "" "line" p3 p4 "")
    	   (textM p11 h "STT") ;"text" "j" "m" p11 h 0 "STT" 
    	   (textM p22 h "T\U+1ECDa \U+0111\U+1ED9 X") ;"text" "j" "m" p22 h 0 "Täa ®é X"
    	   (textM p33 h "T\U+1ECDa \U+0111\U+1ED9 Y") ;"text" "j" "m" p33 h 0 "Täa ®é Y"
      (while (< k n) 
    	(setq xx (nth k tapx)
    	  yy (nth k tapy)
    	 tstt(nth k stt))
    		 (textM PTD h tstt) ;"text" "j" "m" PTD h 0 tstt 
    		 (textM PTX h xx) ;"text" "j" "m" PTX h 0 xx 
    		 (textM PTY h yy) ;"text" "j" "m" PTY h 0 yy 
    		(command "line" PT PTC "")	
    	(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
    		 PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
    	 PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
    	 PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
    	 PTY (list (+ kc (car PTX)) (cadr PTX))
    	  k (+ 1 k))	);while
      (if (= k n)
    	(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
    	  PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
    	  L11 (list (+ di (car PT))(cadr PT))
    	  L22 (list (+ kc (car L11))(cadr L11)))	);if
    (command "line" p3 PT ""
    	  "line" p4 PTC ""
    	  "line" L1 L11 ""
    	  "line" L2 L22 "")
    (setvar "osmode" om ) (setvar "cmdecho" 1)
      (command "Undo" "End")  (princ))
    
    
×