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

Thaistreetz

Nhà quảng cáo
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    905

  • Đã tham gia

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

  • Ngày trúng

    30

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

  3. Đã đăng · Trả lời báo cáo

    Đúng chính xác là đoạn code em cần.

    Nhưng nó có lỗi error: too many arguments

    Em ko biết nó lỗi ở chỗ nào, fiền anh xem lại giúp em với.

    Tiện đây anh có thể giải thích hộ em đoạn này không?

    (ssget "f" (list p1 p2) '((0 . "line")))

    Và nếu em muốn nhận đối tượng gồm cả line và polyline thì làm thế nào? em đã đọc help nhưng không hiểu đoạn này lắm.

    cảm ơn anh nhiều.

  4. Đã đăng · Trả lời báo cáo

    thai1.jpg

    Trong hình trên em có n đường thẳng song song nằm ngang.

    Em đang cần một đoạn code có tác dụng lấy được tập hợp tất cả các tọa độ giao điểm và tập hợp tọa độ các điểm đầu của các đường thẳng nằm ngang khi em vẽ một đường thẳng cắt qua những đường thẳng nằm ngang này. Các Huynh giúp em với. :s_big:

    Edit: em chỉ cần lấy tọa độ của các điểm đầu phía trái (phía có tọa độ x nhỏ)

  5. Đã đăng · Trả lời báo cáo

    Nếu chỉ là nối polyline, bạn không cần lisp.

     

    Cách làm như sau:

    1. Bạn find and replace dấu cách bằng dấu phẩy (,) để dữ liệu có định dạng

    1,2

    2,3

    3,4

    .......

    2. Bạn copy toàn bộ nội dung text này vào clipboard

    3. Bạn vào AutoCAD, gõ lệnh Pline, rồi paste toàn bộ nội dung text này vào dòng command.

    4. Nhấn enter rồi Zoom > E, bạn sẽ nhìn thấy những gì bạn cần.

    Thú thật là em phải nhìn lời giải của Bác Hoành mới biết được bạn ấy đang yêu cầu cái gì. hóa ra số liệu kia là tọa độ điểm. :s_big:

  8. Đã đăng · Trả lời báo cáo

    em vẫn dùng CAD14 nhưng tìm mãi cái tool zoom chuột giữa trên diễn đàn mà không thấy, các Bác có thể up lên diễn đàn được khỗng?

    Diễn đàn có chức năng tìm kiếm. mình gõ từ khóa zoom cad14 1 phát là ra ngay. bạn làm thử 1 lần đi cho biết, lần sau đỡ fải hỏi. Ngay cả Google cũng rất dễ để tìm thấy nó chứ khó khăn gì đâu bạn?

  9. Đã đăng · Trả lời báo cáo

    Code của bạn đây. hi vọng nó đúng ý bạn.

    (prompt"\n[cmd : TDN] - THONG KE TOA DO\n")
----------------------------------------------
(defun C:tdn () (prompt"\nTHONG KE TOA DO\n")
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '()
     ten (getstring "\nTên Nút:"))
(if (not h) (setq h 1))
(if (not i) (setq i 1))
(setq i1  (getreal (strcat"\nSTT Nút Ðâu Tiên < " (rtos i 2 0) " >: "))
   caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if i1 (setq i i1))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
;================================================
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
       x   (rtos (car D1) 2 4)
       y   (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 2 4))
      tapx (append tapx (list x))
      tapy (append tapy (list y))
k   (+ 1 k)
       N   (strcat ten (rtos k 2 0))
       stt (append stt (list N))
 );setq
 (if (>= (car DX) (car D1)) 
(progn
(setq D2 (list (+ (car DX) (* 0.5 h)) (cadr DX)))	   
   	(command "text" "BL" D2 h 0 tX)
 	(setq   TB  (textbox (entget(entlast)))
   		LC  (car TB)
  		RC  (cadr TB)
   		di  (distance LC RC)
	PT3 (polar D2 0 (+ di (* 0.6 h)))
	pt4 (list (car D2) (- (cadr D2) (* 1.35 h)))
	pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.35 h)))		
	C   (polar PT3 0 (* 1.5 h))
 	);setq
 	(command "text" "F" PT4 PT5 h ty
          	 "pline" D1 DX PT3 ""
          	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
          	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
          	 "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N 
          	 "CECOLOR" 8
	 "circle" (polar PT3 0 (* 1.5 h)) (* 1.35 h)
 	  );command
  (setvar "CECOLOR" lacol)
);progn
  );if
 (if (< (car DX) (car D1)) 
(progn
  (setq D2 (list (- (car DX) (* 0.5 h)) (cadr DX)))	   
 	  (command "text" "BR" D2 h 0 tx)
 	  (setq   TB  (textbox (entget(entlast)))
   		  LC  (car TB)
  		  RC  (cadr TB)
   		  di  (distance LC RC)
	  PT3 (polar D2 0 (- (+ di (* 0.6 h))))
	  pt4 (list (- (car D2) di) (- (cadr D2) (* 1.35 h)))
	  pt5 (list (car D2) (- (cadr D2) (* 1.35 h)))
	  PT6 (list (- (car PT3) (* 3 h)) (cadr PT3))
	  C   (polar PT3 0 (* 1.5 h))
 	  );setq
 	  (command "text" "F" PT4 PT5 h TY
          	   "pline" D1 DX PT3 ""
          	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.5 h)
          	   "text" "m" (polar PT6 0 (* 1.5 h)) h 0 N 
          	   "CECOLOR" 8
	   "circle" (polar PT6 0 (* 1.5 h)) (* 1.35 h)
 	  );command
  (setvar "CECOLOR" lacol)
);progn
  );if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
;=============================================
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq	Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq	di (- di (* 1.7 h))
kc (* 2 di)
       PT (getpoint"\nVi tri dat bang")
   	PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTCc (list (+ (* 1.5 kc) (car PTC)) (cadr PT))
     	p1 (list (car PT) (+ (cadr PT)(* 2 h)))
     	p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p2c (list (+ (* 1.5 kc) (car P2)) (cadr p2))
     	p3 (list (car p1) (+ (cadr p1)(* 2 h)))
     	p4 (list (car p2) (+ (cadr p2)(* 2 h)))
p4c (list (+ (* 1.5 kc) (car P4)) (cadr p4))
    	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))
p44 (list (+ (* kc 0.75) (car p4)) (cadr p22))
     	L1 (list (+ di (car p3))(cadr p3))
     	L2 (list (+ kc (car L1))(cadr L1))
L3 (list (+ (* 1.5 kc) (car p4)) (cadr p4))
PTB (list (+ (* 0.5 (+ (* 2 kc) (* 1.5 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
    	n (length tapx)
    	k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2c "" "line" p3 p4c "" "CECOLOR" 2
      	"text" "m" p11 h 0 "STT" 
      	"text" "m" p22 h 0 "Täa ®é X" 
      	"text" "m" p33 h 0 "Täa ®é Y"
"text" "m" p44 h 0 "Ghi chó"
      	"text" "m" pTB (* 1.3 h) 0 "%%UB¶ng thèng kª täa ®é nót")    
(while (< k n) 
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
 "text" "m" PTD h 0 tstt 
        "text" "m" PTX h 0 xx 
        "text" "m" PTY h 0 yy
 "CECOLOR" 3 
        "line" PT PTCc "")    
(setq 	PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
PTCc (list (+ (* 1.5 kc) (car ptc)) (cadr ptc))
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));setq
);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))
L33 (list (+ (* 1.5 kc) (car PTC)) (cadr PTC)) 
);setq
);if
(command "CECOLOR" 3 
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 ""
"line" L3 L33 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toado

    • Vote tăng 1

  10. Đã đăng · Trả lời báo cáo

    Bạn Thaistreetz giúp tớ được không? trong cột thống kê toạ độ điểm nút có thêm cột ghi chú.

    http://www.cadviet.com/upfiles/2/lay_toa_do.lsp

    Giúp thì tớ giúp đc thôi, nhưng bạn post bài lần đầu tiên đã sai chỗ nên tớ cũng nhờ bạn giúp lại tớ là đọc lại hộ tớ 1 lượt nội quy của diễn đàn cũng như nội quy của box này. những gì cần nói tớ cũng đã viết trong tin nhắn cho bạn. fiền bạn trả lời tớ bằng tin nhắn theo nick này để tránh làm ảnh hưởng đến nội dung topic này nhé.

    • Vote tăng 1

  11. Đã đăng · Trả lời báo cáo

    @ Thaistreetz

    1. Lệnh Miline

    2. lệnh quick select hay lệnh filter : Có thể chọn đối tượng có màu là Bylayer. Nhưng không phân biệt được màu, cái nào là màu xanh, cái nào là màu vàng ......

     

    Có lựa chọn theo màu được mà anh. trong hộp thoai filter mình chọn đối tượng là Color, bên cạnh có nút Select, bấm vào đó để chọn màu. Ví dụ với màu đỏ thì ta sẽ có Object selection là: Color = 1-red

    Edit: Ah em nhầm. Nếu layer có màu trùng với màu đc chọn thì sẽ không nhận diện đc.

    Có lần anh Duy viết hộ em cái lisp xóa đói tượng theo màu cũng gặp fải vấn đề này. bg em mới nhớ :s_big:

  12. Đã đăng · Trả lời báo cáo

    Nhờ các bác cao thủ viết giúp em LISP có yêu cầu như thế này:

    1.Khi thực hiện lệnh, ta có thể vẽ đồng thời 2 đường line hay 2 đường polyline, hoặc arc...với khoảng cách của 2 đường và màu sắc có thể thay đổi do người dùng.VD: khi vẽ, tạo ra đồng thời 2 đường line, line 1 màu số 4, line 2 màu số 8

    2.Lisp thứ 2 là khi thực hiện ta có thể chon các đối tượng cùng màu để đưa vào 1 lớp.

    Thank các bác cao thủ nhiều...

     

    - Lisp 1: Đề thiếu: Khoảng cách giữa 2 đường bằng bao nhiêu? điểm pick để vẽ nằm ở vị trí nào: giữa 2 đường hay thuộc 1 trong 2 đường.

    Mà mình nhớ không nhầm thì cad cũng đã có lệnh vẽ các đường song song với nhau. tuy nhiên mình không nhớ lệnh. Với lại việc này có thể vẽ bình thường rồi offset cũng đâu có mất thời gian mấy đâu bạn?

    - Lisp 2: bạn có thể dụng lệnh qick select hay lệnh filter.

  13. Đã đăng · Trả lời báo cáo

    taị vì khi bạn thay đổi mã nguồn thì bạn phải thay đổi cả font của nó thì nó với hiểu được chứ...

    Tái bút: bạn có thể tham khảo chương trình này của Tomboy viết nhằm chuyển mã TCVN3 sang VNI nhé, còn chuyển từ mã này qua mã kia và ngược lại thì cũng trên nguyên tắc này thôi, nhưng tại vì mình bận quá nên chưa viết được, rất mong sự cộng tác của bạn hoàn thành nốt đoạn chương trình này để anh em diễn đàn được nhờ. Thanks

    linh nè: http://www.cadviet.com/upfiles/2/chm.rar

    note: mình mới chỉ viết chuyển mã cho TEXT chứ MTEXT thì chưa làm vì vậy nhờ Thaistreetz hoàn thành nốt nhé

     

    Tất nhiên là mình đã chạy lisp với các font unicode rồi. Mình ví dụ đơn giản với code này nhé

    (defun c:TT ()

    (setq PT (getpoint "\nChon diem chen text:"))

    (command "TEXT" pt 2 0 "Chào mừng bạn đến với Cad việt")

    )

    Mình dùng cad 2008, chạy với textstyle dùng 1 trong 3 font: time new roman, aria và tahoma là 3 font thuộc bảng mã Unicode.

    kết quả ghi ra màn hình của mình được thế này: Chào mừng bạn đến vá»›i Cad việt

     

    Công việc của mình cũng hơi bận chút vì fải đá thêm ngoài nữa, cuối tuần rảnh hơn mình sẽ nghiên cứu code của bạn sau vậy.

  14. Đã đăng · Trả lời báo cáo

    Tue_NV có thể viết được nhưng rất tiếc là mình không có nhiều thời gian để viết Lisp này vì như anh Duy đã nói là xây dựng 1 danh sách chuyển đổi giữa danh sách nguồn và danh sách đích tốn rất nhiều thời gian cho nên Tue_NV chưa thể hoàn thành Code được. Mong bạn thông cảm

    Hôm nay em có viết hộ 1 lisp cho một người bạn, cậu ta yêu cầu sử dụng Unicode đối với các text mà lisp vẽ ra màn hình. Và em phát hiện ra là lisp hình như không hỗ trợ nhận dạng bảng mã Unicode. Em viết bằng notepad và đã save as với Encoding là UTF-8. Lisp chạy được nhưng hoàn toàn không nhận diện đc các ký tự tiếng việt của bảng mã Unicode.

     

    Như vậy nếu ta có xây dựng được danh sách mã nguồn (Bảng mã Unicode) và mã đích (bảng mã VNI) thì lisp cũng chỉ nhận diện được mã đích nên có lẽ sẽ không thể dùng được cách mà lisp chuyển từ TCVN3 sang VNI đã làm.

  15. Đã đăng · Trả lời báo cáo

    Bác tucdrom viết như vậy là đúng nhưng vẫn còn thiếu rồi. Nếu làm như bác thì trong TN chỉ nhận một điểm cao độ, đó là điểm tim mà bác sửa thôi còn các điểm khác vẫn giữ nguyên. Do vậy khi sửa cao độ ở trắc dọc đồng thời ta phải sửa tất cả các điểm cao độ ở TN đó kể cả bên phải và bên trái. Sau khi sửa xong ta ấn "Nhận" là ok! => xoá TN cũ đi, chạy lại TN mới.

    Làm thế này không được hay cho lắm. Bạn chỉ cần làm như sau: gõ lệnh sửa số liệu (ssl hoặc sslt). trước khi sửa cao độ cọc tim (sửa cao độ trên trắc dọc) thì bật hộp thoại lựa chọn trên thanh công cụ lên và chọn chế độ điền cao độ trên trắc ngang là cao độ tương đối (so với cọc tim). Sau đó bạn mới sửa cao độ trên trắc dọc thì tự khắc cao độ trên trắc ngang cũng sẽ được cộng trừ thêm số gia như cọc tim.

    Việc sửa khoảng cách trên trắc dọc và trắc ngang cũng thế. Tùy nhu cầu mà lựa chọn khoảng cách là cộng dồn hay khoảng cách lẻ.

    Nói chung Nova đã khá linh động khi cho ta các lựa chọn về cách nhập số liệu tuyến để quá trình chỉnh sửa đc dễ dàng nhất. Nhưng đa số chúng ta không biết cách mà dùng.

    • Vote tăng 1

  16. Đã đăng · Trả lời báo cáo

    Việc này làm được đấy, tuy nhiên chỉ có thể làm tự động bằng bản nova NTD16 (cad2005) các bản nova cũ thì chỉ có cách nhập thủ công bằng lệnh sửa số liệu.

    Hic! lâu rồi mình ko dùng bản R16. mình nhớ mang máng nó nằm trong lệnh edit trắc ngang (EDTN). bạn thử gõ lệnh này xem. sau khi edit xong hình như bạn fải chạy lại trắc ngang thì số liệu cập nhật mới ko bị lỗi.

  19. Đã đăng · Trả lời báo cáo

    Chào Thaistreetz

    Tue_NV xin góp ý với bạn : Mình xin nói thẳng : Bạn nên rút kinh nghiệm : với những chuyện mà ta chưa biết thì chúng ta không nên nói, chúng ta nên yên lặng để tiếp thu những cái mà ta chưa biết để ta học hỏi. Điều đó không có nghĩa là chúng ta giấu những cái ta chưa biết. Mình cũng đã học từ bài học này rất nhiều nay xin góp ý với bạn. Mong bạn hiểu đừng giận

     

    Ồ, đúng là em đã suy nghĩ theo lối mòn. khi nghe đến convert bảng mã là trong đầu em nghĩ ngay đến việc sử dụng clipboard để chuyển đổi giống như những chương trình convert khác. em đã xem cách thức mà lisp convert từ TCVN3 về VNI đã sử dụng, quả thật rất hay và đơn giản mà em không nghĩ ra.

    Cảm ơn anh vì đã góp ý. thực ra ở diễn đàn này em cũng đã học được rất nhiều từ những sự góp ý và giúp đỡ của anh :s_big:

  20. Đã đăng · Trả lời báo cáo

    hôm trước chị thaistreet có bảo em cách nhập ssố liệu bằng lệnh rtdn em làm theo thấy thành công chị ạ.em thử nhập số liệu của 11 cọc nhưng khi em xuất tuyến thì chỉ được có 7 cọc,ko biết số liệ của 4 cọc kia có vấn đề gì mà no ko xuất hiện.mong mọi người giúp em với

    Tía ơi! cười chít mất thui. hic hic.

    file NTD của em không có vấn đề gì đâu. Chị vẫn chạy ra đủ 12 cọc (cọc 3 và 4 trùng nhau). KiuKiu cũng chạy ra được kết quả như chị kìa. Chắc có lẽ bản nova của em có vấn đề gì đó.

    PS: Tớ là con trai cậu ạ =))

  22. Đã đăng · Trả lời báo cáo

    TUE có thể viết giúp mình được ko?viết dùm mình lisp convert text và Mtext từ mã VNI windows sang unicodevà ngược lại ko vậy?cảm ơn bạn rất nhiều!

    Không fải cái gì lisp cũng làm được, convert text có lẽ chỉ có VB mới làm được. Mình chưa biết hết các hàm của Lisp nhưng mình nghĩ lisp là ngôn ngữ thuần tuý fục vụ cho cad trong khi hệ thống font và bảng mã là vấn đề của hệ điều hành. Phải một ngôn ngữ lập trình ngoài Cad mới có khả năng làm việc đó.

     

    To Thaistreetz

    Có phải bạn nói dòng này :

    (mapcar '/ (mapcar '+ (car lst_pt) (cadr lst_pt)) '(2.0 2.0))

    Thanks anh Gia_Bach nhe. để đêm nay xem xong trận Arsenal em nghiên cứu thử code này xem thế nào. Em tính mót lại cái code của Bác Hoành mà không tim được. có lẽ đành thử chuyển qua hướng khác vậy. (ngủ thui^^)

    • Vote tăng 1

  23. Đã đăng · Trả lời báo cáo

    Mọi người ơi tôi học cad được có vài hôm mà cô giáo đã bắt vẽ các đò vật 3D mình tự chọn để làm bài tập lớn.Tôi định vẽ chiếc quạt điện nhưng chẳng rõ vẽ như thế nào?Ai có bản vẽ đó thì gửi cho tôi với.Nếu có các lệnh vẽ theo từng đoạn thì tốt.Cám ơn nhìu!!

    Nếu ai có thì gửi mail cho mình nhé:khinaoemve1989@yahoo.com

    =)) vẽ con rubik đi bạn. mới học vẽ cad mà bạn chọn vẽ cái quạt điện thì nộp bài cô giáo cũng phát hoảng đấy, chả dám dạy bạn nữa đâu.

  24. Đã đăng · Trả lời báo cáo

    ok ! Thật tuyệt vời bạn à . Nhưng mình góp ý là bạn nên thêm dòng lệnh này vào đầu tiên :

    (command "layer" "N" "caodococ" "S" "caodococ" "color" 3 "" "")

    Vậy thì bạn dòng này vào khai báo biến đầu lisp: (setq OldLay (getvar "clayer"))

    và dòng này vào cuối lisp: (setvar "clayer" OldLay)

    mục đích để lisp hoàn trả lại layer hiện thời khi kết thúc lệnh.

    • Vote tăng 1

  25. Đã đăng · Trả lời báo cáo

    Vấn đề là thế này bạn ạ !!! Tên cọc trên tuyến đường, Nó là hệ thống liên quan giữa Bình đồ- trắc dọc - Trắc ngang và giữa các phòng ban trong cty đều sử dụng chung. Mục đích của mình muốn bạn giúp mình là muốn thống kê tọa độ của các cọc đó. Việc ko nhập được tên cọc vào lisp sẽ ko thống kê được tọa độ của các cọc đó. Hjxhjx. trong trường hợp này việc mình phải đối chiếu so sánh giữa tên cọc của mình và tên cọc có sẵn rùi ghi ra giấy để edit lại bảng tọa độ rất mất thời gian. Bạn cho mình giải pháp đi...huhuhu Minh ko phải là dốt CAD, nhưng trong trường hợp này, Nếu lisp của bạn mà hỗ trợ được mình giúp cho mình nhập tên cọc vào được thì công việc của mình sẽ thuận lợi hơn biết bao. bởi vì số lượng tuyến đường mà mình phải thống kê tọa độ như vậy là rất nhiều, rất nhiều chứ ko phải là ít. Bạn giúp mình đi !!! Cảm ơn bạn nhé !!!

     

    Hi vọng bạn đã hài lòng với code này.

    - Cho phép lựa chọn ghi tên điểm tọa độ tự động (giống lisp trước) hay thủ công (Pick chuột vào text có sẵn - tên cọc trên tuyến chẳng hạn)

    - Cho phép ghi text tọa độ theo một góc xiên bất kỳ

    - Cho phép lựa chọn có xuất bảng tọa độ hay không.

    (prompt"\n[cmd : TDN] - THONG KE TOA DO by Thaistreetz - huuthais@yahoo.com\n")
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
(setq om (getvar "osmode"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:")))
(if caot1 (setq h caot1))
(setq tapx '() tapy '() stt '())

(setq bit1 (cond (bit1) ("Yes")))
(initget "Yes No")
(setq	Tmp1 (strcat "\nTu dong ghi ten nut? [Yes/No] <" bit1 ">: ")
bit1 (cond ((getkword Tmp1)) (bit1)))
(if (eq bit1 "Yes")
(progn 
(setq ten (getstring "\nTen Nut:"))
(if (not i) (setq i 1))
(setq i1  (getreal (strcat"\nSTT cua nut bat dau < " (rtos i 2 0) " >: ")))
(if i1 (setq i i1))

(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text "(rtos (+ k 1) 2 0)"") Dx)
angr (angle Dx Dy)
angd (/ (* 180 angr) pi)
       x   (rtos (car D1) 2 4)
       y   (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 2 4))
      tapx (append tapx (list x))
      tapy (append tapy (list y))
k   (+ 1 k)
       N   (strcat ten (rtos k 2 0))
       stt (append stt (list N))
 );setq
 (if (>= (car DY) (car DX)) 
 (progn
(setq D2 (polar Dx angr (* 0.7 h)))  	   
   	(command "text" "BL" D2 h angd tX)
 	(setq   TB  (textbox (entget(entlast)))
   		LC  (car TB)
  		RC  (cadr TB)
   		di  (distance LC RC)
	PT3 (polar D2 angr (+ di (* 0.4 h)))
	pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
	pt5 (polar pt4 angr di)		
	C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
          	 "pline" D1 DX PT3 ""
          	 "circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
          	 "text" "m" (polar PT3 angr (* 1.5 h)) h angd N 
          	 "CECOLOR" 8
	 "circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
 );progn
 );if
 (if (< (car DY) (car DX)) 
(progn
(setq D2 (polar Dx angr (* 0.7 h)))	   
 	(command "text" "BR" D2 h (+ angd 180) tx)
 	(setq   TB  (textbox (entget(entlast)))
	LC  (car TB)
	RC  (cadr TB)
	di  (distance LC RC)
	PT3 (polar D2 angr (+ di (* 0.4 h)))
	pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
	pt5 (polar pt4 angr di)		
	C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
	"pline" D1 DX PT3 ""
	"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
	"text" "m" (polar PT3 angr (* 1.5 h)) h (+ angd 180) N 
	"CECOLOR" 8
	"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
 );if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(if (eq bit1 "No")
(progn 
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") i 1 k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" om)
 (progn
 (setq LOOP T)
 (while (= LOOP T)
 (while (null (setq ten (nentsel "\nChon mot text lam ten nut: ")))
(princ "\nChua tim thay doi tuong la text, chon lai !"));while
 (setq Source_text (entget (car ten)))
 (if	(or (= (cdr (assoc '0 Source_text)) "TEXT")
    (= (cdr (assoc '0 Source_text)) "MTEXT")
    (= (cdr (assoc '0 Source_text)) "ATTRIB"));or
(progn
(setq N (cdr (assoc 1 Source_text)))
(setq LOOP nil));progn
(progn
(princ "Phai chon mot text lam ten nut !")
(setq LOOP T));progn
 )if
 );while
 );progn
(setvar "osmode" 0)
(setq 	DX (getpoint (strcat"\nDiem dat text cua nut "N"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text") Dx)
angr (angle Dx Dy))	
(setq	angd (/ (* 180 angr) pi)
       x   (rtos (car D1) 2 4)
       y   (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Car D1) 2 4))
TY (strcat "Y:"(rtos (Cadr D1) 2 4))
      tapx (append tapx (list x))
      tapy (append tapy (list y))
k   (+ 1 k)
       stt (append stt (list N))
);setq
 (if (>= (car DY) (car DX)) 
(progn
(setq D2 (polar Dx angr (* 0.7 h)))  	   
   	(command "text" "BL" D2 h angd tX)
 	(setq   TB  (textbox (entget(entlast)))
   		LC  (car TB)
  		RC  (cadr TB)
   		di  (distance LC RC)
	PT3 (polar D2 angr (+ di (* 0.4 h)))
	pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
	pt5 (polar pt4 angr di)		
	C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
          	 "pline" D1 DX PT3 ""
          	 "circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
          	 "text" "m" (polar PT3 angr (* 1.5 h)) h angd N 
          	 "CECOLOR" 8
	 "circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
 );if
 (if (< (car DY) (car DX)) 
(progn
(setq D2 (polar Dx angr (* 0.7 h)))	   
 	(command "text" "BR" D2 h (+ angd 180) tx)
 	(setq   TB  (textbox (entget(entlast)))
	LC  (car TB)
	RC  (cadr TB)
	di  (distance LC RC)
	PT3 (polar D2 angr (+ di (* 0.4 h)))
	pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
	pt5 (polar pt4 angr di)		
	C   (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
	"pline" D1 DX PT3 ""
	"circle" (polar PT3 angr (* 1.5 h)) (* 1.5 h)
	"text" "m" (polar PT3 angr (* 1.5 h)) h (+ angd 180) N 
	"CECOLOR" 8
	"circle" (polar PT3 angr (* 1.5 h)) (* 1.35 h)
);command
(setvar "CECOLOR" lacol)
);progn
 );if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn 
);if
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq	Tmp (strcat "\nXuât Bang Toa Ðô? [Yes/No] <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq	di (- di (* 0.4 h))
kc (* 2 di)
       PT (getpoint"\nVi tri dat bang")
   	PTC (list (+ (* 2 kc) (- di h h h h) (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) (- 0 h) (car PTD)) (cadr PTD))
    	PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
     	p11 (list (+ (/ di 2) (car p1))  (+ (* 1.1 h) (cadr p1)))
     	p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h)))
     	p33 (list (+ kc (- h h h h) (car p22)) (cadr p22))
     	L1 (list (+ di (car p3))(cadr p3))
     	L2 (list (+ kc (- 0 h h)(car L1))(cadr L1))
PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
    	n (length tapx)
    	k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2
      	"text" "m" p11 h 0 "Tªn Nót" 
      	"text" "m" p22 h 0 "Täa ®é X" 
      	"text" "m" p33 h 0 "Täa ®é Y"
      	"text" "m" pTB (* 1.3 h) 0 "%%UB¶ng thèng kª täa ®é nót")    
(while (< k n) 
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
 "text" "m" PTD h 0 tstt 
        "text" "m" PTX h 0 xx 
        "text" "m" PTY h 0 yy
 "CECOLOR" 3 
        "line" PT PTC "")    
(setq 	PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq 	PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (- 0 h h) (car L11))(cadr L11))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do

×