Lisp ghi tọa độ rất hay mà bị lỗi!

Tháng 8 12, 2009

đoạn lisp ghi toạ độ XY của 1 điểm ra màn hình này đang bị lỗi, hiện jờ cái toạ độ Y=... thường hay bay đi xa xa toạ độ x=... khi mà mở bản vẽ cũ ra sử dụng lisp, nếu mở cái bản vẽ mới tinh ra thì ko bị lỗi thế...

Và cái tọa độ Y=... ko cùng lớp với toạ độ X, em muốn tọa độ X và Y cùng lớp và là các đối tượng có tính chất giống nhau !

và Em muốn có thêm dòng nhập khoảng cách giữa 2 hàng toạ độ.

X=...

Y=...

Cụ thể:

Command

xy

Pick diem:( chọn điểm lấy toạ độ)

Nhap khoang cach x,y : ( Nhập vào khoảng cách của 2 hàng toạ độ X và Y, có thêm tính năng nhớ giá trị nhập lần trước)

ok

CODE

(defun c:xy()

(defun SETERR(s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

); of If

(setq *error* oer seterr nil)

(princ)

); of SETERR

(setq oer *error* *error* seterr)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE")))

(setq pt1 (getpoint "Pick First Point:"))

(setq pt2 (getpoint pt1 "Pick Second Point:"))

(setq px (car pt1))

(setq py (cadr pt1))

;****** real to string

(setq pxt (strcat "X=" (rtos px 2 (getvar "luprec"))))

(setq pyt (strcat "Y=" (rtos py 2 (getvar "luprec"))))

(command "dim1" "leader" pt1 pt2 "" pxt)

(setq txtpnt (cdr (assoc 10 (entget (entlast)))))

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts)) 2.0))

(if (< (car pt2) (car pt1))

(setq algn "MR")

(setq algn "ML")

)

(command "TEXT" algn txtpnt1 ts "0.0" pyt)

(setq *error* oer seterr nil)

(princ)

)

Tháng 8 12, 2009

đoạn lisp ghi toạ độ XY của 1 điểm ra màn hình này đang bị lỗi, hiện jờ cái toạ độ Y=... thường hay bay đi xa xa toạ độ x=... khi mà mở bản vẽ cũ ra sử dụng lisp, nếu mở cái bản vẽ mới tinh ra thì ko bị lỗi thế...
Và cái tọa độ Y=... ko cùng lớp với toạ độ X, em muốn tọa độ X và Y cùng lớp và là các đối tượng có tính chất giống nhau !

và Em muốn có thêm dòng nhập khoảng cách giữa 2 hàng toạ độ.

X=...

Y=...

Cụ thể:

Command

xy

Pick diem:( chọn điểm lấy toạ độ)

Nhap khoang cach x,y : ( Nhập vào khoảng cách của 2 hàng toạ độ X và Y, có thêm tính năng nhớ giá trị nhập lần trước)

ok

CODE

(defun c:xy()

(defun SETERR(s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

); of If

(setq *error* oer seterr nil)

(princ)

); of SETERR

(setq oer *error* *error* seterr)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE")))

(setq pt1 (getpoint "Pick First Point:"))

(setq pt2 (getpoint pt1 "Pick Second Point:"))

(setq px (car pt1))

(setq py (cadr pt1))

;****** real to string

(setq pxt (strcat "X=" (rtos px 2 (getvar "luprec"))))

(setq pyt (strcat "Y=" (rtos py 2 (getvar "luprec"))))

(command "dim1" "leader" pt1 pt2 "" pxt)

(setq txtpnt (cdr (assoc 10 (entget (entlast)))))

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts)) 2.0))

(if (< (car pt2) (car pt1))

(setq algn "MR")

(setq algn "ML")

)

(command "TEXT" algn txtpnt1 ts "0.0" pyt)

(setq *error* oer seterr nil)

(princ)

)

như bạn nói có lẽ bản vẽ của bạn đã bị thay đổi trục toạ độ, bạn có thể viết đoạn mã sau:

(defun c:oc()

(command "ucs" "w" )

)

mỗi khi có hiện tượng như bạn nói thì hãy đánh lệnh oc là ok ngay, còn để sửa mã của đoạn code vừa rồi thì hãy đợi mình 5' nhé.

Tháng 8 12, 2009

như bạn nói có lẽ bản vẽ của bạn đã bị thay đổi trục toạ độ, bạn có thể viết đoạn mã sau:
(defun c:oc()

(command "ucs" "w" )

)

mỗi khi có hiện tượng như bạn nói thì hãy đánh lệnh oc là ok ngay, còn để sửa mã của đoạn code vừa rồi thì hãy đợi mình 5' nhé.

-------------------------------------

ok mình đã sửa lại mã chương trình cho bạn:

(defun c:xy ( / ts pt1 pt2 px py pxt pyt txtpnt txtpnt1 txtpnt2 algn d alp)

(defun SETERR (s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

) ; of If

(setq *error* oer

seterr nil

)

(princ)

) ; of SETERR

(setq oer *error*

*error* seterr

)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE")))

(setq pt1 (getpoint "\nPick First Point:"))

(setq pt2 (getpoint pt1 "\nPick Second Point:"))

(setq px (car pt1))

(setq py (cadr pt1))

;****** real to string

(setq pxt (strcat "X=" (rtos px 2 )))

(setq pyt (strcat "Y=" (rtos py 2 )))

(command "dim1" "leader" pt1 pt2 "" pxt)

(setq txtpnt (cdr (assoc 10 (entget (entlast)))))

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts))

2.0

)

(setq d(sqrt (+ (* ts ts) (* 100 100))))

(setq alp(atan (/ ts 100)))

(setq txtpnt2 (polar txtpnt1 alp d))

(command "MTEXT" txtpnt1 txtpnt2 pyt "")

(setq *error* oer

seterr nil

)

(princ)

)

Tháng 8 13, 2009

-------------------------------------
ok mình đã sửa lại mã chương trình cho bạn:

(defun c:xy ( / ts pt1 pt2 px py pxt pyt txtpnt txtpnt1 txtpnt2 algn d alp)

(defun SETERR (s)

(if (/= s "Function cancelled")

(princ (strcat "\nError: " s))

) ; of If

(setq *error* oer

seterr nil

)

(princ)

) ; of SETERR

(setq oer *error*

*error* seterr

)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE")))

(setq pt1 (getpoint "\nPick First Point:"))

(setq pt2 (getpoint pt1 "\nPick Second Point:"))

(setq px (car pt1))

(setq py (cadr pt1))

;****** real to string

(setq pxt (strcat "X=" (rtos px 2 )))

(setq pyt (strcat "Y=" (rtos py 2 )))

(command "dim1" "leader" pt1 pt2 "" pxt)

(setq txtpnt (cdr (assoc 10 (entget (entlast)))))

(setq txtpnt1 (list (car txtpnt)

(- (cadr txtpnt) (* 2.0 ts))

2.0

)

)

(setq d(sqrt (+ (* ts ts) (* 100 100))))

(setq alp(atan (/ ts 100)))

(setq txtpnt2 (polar txtpnt1 alp d))

(command "MTEXT" txtpnt1 txtpnt2 pyt "")

(setq *error* oer

seterr nil

)

(princ)

)

Cảm ơn bác rất nhiều, nó chạy được rồi nhưng mà với bản vẽ khác nhau thì các đối tượng X=... và y=... lại khác nhau

Em muốn nó giống nhau ấy. Bác sửa giúp em đi.

Đây là hình ảnh 2 toạ độ khác nhau

http://www.cadviet.com/upfiles/2/xy.jpg

Đây là File CÀD của em !!!

http://www.cadviet.com/upfiles/2/mb_tong_the.dwg

Tháng 8 13, 2009

Cảm ơn bác rất nhiều, nó chạy được rồi nhưng mà với bản vẽ khác nhau thì các đối tượng X=... và y=... lại khác nhau
Em muốn nó giống nhau ấy. Bác sửa giúp em đi.

Đây là hình ảnh 2 toạ độ khác nhau

http://www.cadviet.com/upfiles/2/xy.jpg

Đây là File CÀD của em !!!

http://www.cadviet.com/upfiles/2/mb_tong_the.dwg

Lisp trên được tác giả của nó viết để áp dụng cho riêng một mẫu bản vẽ với các thuộc tính units, text style, dim style... của riêng tác giả. chính vì thế nó chỉ có thể chạy tốt với những bản vẽ có các thuộc tính tương tự bản vẽ của tác giả.

Mình thấy nhu cầu của bạn tương đối giống 1 bạn trước đây đã nhờ Cadviet một lisp tương tự nên mình sửa lại lisp cũ.

Khi chạy lisp này sẽ yêu cầu bạn nhập chiều cao text và tên của Nút tọa độ cần thống kê. nếu không cần nhập tên Nút thì lisp sẽ chỉ ghi tọa độ và số thứ tự của nút. kết thúc lisp sẽ thống kê 1 bảng tọa độ các nút cho bạn. hi vọng nó là thứ bạn cần.

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:tdn ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
(setq om (getvar "osmode"))
(setq tapx '() tapy '() stt '() k 0
     ten (getstring "\nNhap ten nut:"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >:")))
(if caot1 (setq h caot1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor"))
;================================================
(While
(setq   D1 (getpoint "\nPick diem toa do:"))
(Progn
 (setvar "osmode" 0)
 (setq DX (getpoint "\nDiem dat text:" 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.4 h)))
	pt5 (list (+ (car D2) di) (- (cadr D2) (* 1.4 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.4 h)))
	  pt5 (list (car D2) (- (cadr D2) (* 1.4 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
;=============================================
;tao bang thong ke
 (setq di (- di (* 2 h))
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))
PTB (list (+ (* 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 "STT" 
      	"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 (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));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))
    );setq
  );if
(command "CECOLOR" 3 
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(setvar "cmdecho" 1)
(prompt"\nxong\n")
(command "Undo" "End")
(princ)
);DONG toado

Tháng 8 14, 2009

Lisp này bị lỗi lắm. Khi mở bản vẽ mới ra chạy thì chạy được. nhưng mình ko thể chạy được trên các bản vẽ đã có từ trước. huhuhu !!!!!!

VÀ có 1 điều nữa. khi mình nhập tên điểm là 2 chẳng hạn thì lisp laị vẽ ra tên điểm là 21

Các bác Pro sửa giúp em với !!!

Đây là file bản vẽ mà lisp ko chạy được :

http://www.cadviet.com/upfiles/2/1_2.dwg

Tháng 8 14, 2009

Hjx ! Lisp của bạn có chạy được đâu.Mình Down về đánh lệnh TD chẳng thấy hiểu lệnh j cả .huhuhu

hic! Có lẽ trong lúc post bài mình đã "làm rơi" mất một dấu ngoặc ở đâu đó. mình đã edit lại code trên rồi đấy, bạn thử lại xem.

PS: bạn edit lại post trên và xóa phần Code đã Quote đi để người sau vào đỡ nhầm nhé. nhớ lần sau có Quote bài của ai đó thì đừng Quote phần code tránh rối mắt người đọc nhé bạn.

Tháng 8 17, 2009

hic! Có lẽ trong lúc post bài mình đã "làm rơi" mất một dấu ngoặc ở đâu đó. mình đã edit lại code trên rồi đấy, bạn thử lại xem.

PS: bạn edit lại post trên và xóa phần Code đã Quote đi để người sau vào đỡ nhầm nhé. nhớ lần sau có Quote bài của ai đó thì đừng Quote phần code tránh rối mắt người đọc nhé bạn.

sao lisp bạn post lên bị lỗi mà bạn ko post lại bài vậy ???

Tháng 8 17, 2009

sao lisp bạn post lên bị lỗi mà bạn ko post lại bài vậy ???

Sặc. chán bạn thật. chỉ tìm code mà không đọc kỹ bài viết ngay phía trên của mình à? (bài số #7 ấy)

Mình đã bảo là mình sửa lại lỗi trực tiếp vào code mình đã post ở bài số #5. bạn cứ copy về là xài được thôi.

và nhờ bạn edit lại bài số #6 của bạn, xóa phần code cũ mà bạn đã trích dẫn ở bài số 5 của mình đi để những ai vào topic này sau đỡ copy nhầm cái code lỗi ấy.

làm ơn đọc lại những gì mình viết hộ cái :bigsmile:

Tháng 8 18, 2009

Sặc. chán bạn thật. chỉ tìm code mà không đọc kỹ bài viết ngay phía trên của mình à? (bài số #7 ấy)
Mình đã bảo là mình sửa lại lỗi trực tiếp vào code mình đã post ở bài số #5. bạn cứ copy về là xài được thôi.

và nhờ bạn edit lại bài số #6 của bạn, xóa phần code cũ mà bạn đã trích dẫn ở bài số 5 của mình đi để những ai vào topic này sau đỡ copy nhầm cái code lỗi ấy.

làm ơn đọc lại những gì mình viết hộ cái :bigsmile:

Lisp này bị lỗi lắm. Khi mở bản vẽ mới ra chạy thì chạy được. nhưng mình ko thể chạy được trên các bản vẽ đã có từ trước. huhuhu !!!!!!

VÀ có 1 điều nữa. khi mình nhập tên điểm là 2 chẳng hạn thì lisp laị vẽ ra tên điểm là 21

Và tên nút ko được nhập bằng tay vào khi pick từ điểm thứ 2 trở đi. Tên đó phải do người dùng nhập vào !!!

Các bác Pro sửa giúp em với !!!

Đây là file bản vẽ mà lisp ko chạy được :

http://www.cadviet.com/upfiles/2/1_2.dwg

Nhưng bài toán thực tế bài toán ghi toạ độ đối với tuyến đường thì lại khác bạn à !!! Tuyến đường nó cong và dài. Do vậy ko phải khi nào chữ ghi toạ độ nó cũng nằm theo phương ngang.Mình muốn bạn sửa cái lisp đó để mình có thể tự xác định được phương của chữ ghi toạ độ, tức là thêm 1 dọc pick điểm để xác định phương của chữ nữa !!!!

Command: TDN

Nhập chiều cao Text<2> :

Nhap ten nut:

Pick điểm lấy toạ độ(point 1):

point2:

point3:

....

Nhap ten nut:

Pick điểm lấy toạ độ(point 1):

point2:

point3:

....

Nhap ten nut:

Pick điểm lấy toạ độ(point 1):

point2:

point3:

Vi tri dat bang:

ok !!!

Phương của chữ ghi kích thước sẽ trùng với phương của đoạn nối point2 với point3

Tháng 8 18, 2009

Lisp này bị lỗi lắm. Khi mở bản vẽ mới ra chạy thì chạy được. nhưng mình ko thể chạy được trên các bản vẽ đã có từ trước. huhuhu !!!!!!
VÀ có 1 điều nữa. khi mình nhập tên điểm là 2 chẳng hạn thì lisp laị vẽ ra tên điểm là 21

Và tên nút ko được nhập bằng tay vào khi pick từ điểm thứ 2 trở đi. Tên đó phải do người dùng nhập vào !!!

Các bác Pro sửa giúp em với !!!

Đây là file bản vẽ mà lisp ko chạy được :

http://www.cadviet.com/upfiles/2/1_2.dwg

Nhưng bài toán thực tế bài toán ghi toạ độ đối với tuyến đường thì lại khác bạn à !!! Tuyến đường nó cong và dài. Do vậy ko phải khi nào chữ ghi toạ độ nó cũng nằm theo phương ngang.Mình muốn bạn sửa cái lisp đó để mình có thể tự xác định được phương của chữ ghi toạ độ, tức là thêm 1 dọc pick điểm để xác định phương của chữ nữa !!!!

Command: TDN

Nhập chiều cao Text<2> :

Nhap ten nut:

Pick điểm lấy toạ độ(point 1):

point2:

point3:

....

Nhap ten nut:

Pick điểm lấy toạ độ(point 1):

point2:

point3:

....

Nhap ten nut:

Pick điểm lấy toạ độ(point 1):

point2:

point3:

Vi tri dat bang:

ok !!!

Phương của chữ ghi kích thước sẽ trùng với phương của đoạn nối point2 với point3

Lisp trên không sai. ngay cả đối với text style hiện thời trong bản vẽ của bạn mình vẫn có thể chạy được ngon lành. nếu có gì đó sai thì chỉ là việc bạn chẳng hiểu gì về bản vẽ mà mình đang làm cả. vì sao mình nói vậy? với lisp trên bạn thử chạy nó với chiều cao text là 5000 thử xem.

Bạn chú ý điều này nữa: từ giờ trở đi, với bất kỳ lisp nào bạn sử dụng mà có yêu cầu nhập chiều cao text thì hãy chắc chắn rằng text style bạn sử dụng phải được thiết lập chiều cao mặc định ban đầu là 0 thì mới chạy được.

Về vấn đề tên nút cần thống kê tọa độ. lisp này chia thành 2 phần.

- phần tên là ký tự. ví dụ: nhập N chẳng hạn

- phần tên là số thứ tự: 1, 2 ,3

Như vậy khi truy vấn tọa độ, tên các điểm sẽ có dạng N1, N2, N3.... nếu không nhập Tên nút (enter để bỏ qua) nó sẽ được ghi dưới dạng chỉ có số thứ tự: 1, 2, 3...

Hay nếu không thì bạn hãy sửa tên nút bằng cách edit text sau khi chạy xong hoặc xóa nó đi tùy nhu cầu của bạn. làm việc này cũng chẳng khác gì việc bạn phải nhập tên nút cho mỗi lần pick. OK?

Về vấn đề thống kê tọa độ cọc trên tuyến. chắc chắn mình không làm nữa. vì bản thân nova đã cung cấp đủ công cụ cho bạn

Cọc trên tuyến thì đã có tên cọc. bạn chỉ cần chạy bảng tọa độ cọc nữa là xong. không ai gán cái tọa độ vào cọc làm gì cả cho rối bình đồ tuyến.

Lisp này mình nghĩ là tương đối hoàn thiện cho nhu cầu chung của mọi người. mình sẽ không sửa lại nó nữa. nói thật là mình chán nó lắm rồi :bigsmile:

Tháng 8 18, 2009

Đây là đoạn lisp mình viết riêng cho anh em trong cty mình dùng, nó có thêm một số lựa chọn có xuất bảng thống kê hay không. ngoài ra nó cũng được viết để phù hợp với việc bạn fải chạy lệnh nhiều lần trong 1 phiên làm việc. dùng cái nào tùy bạn nhé.

(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"))
(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))  
     	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))
PTB (list (+ (* 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 "STT" 
      	"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 (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));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))
);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 toado

Tháng 8 19, 2009

Đây là đoạn lisp mình viết riêng cho anh em trong cty mình dùng, nó có thêm một số lựa chọn có xuất bảng thống kê hay không. ngoài ra nó cũng được viết để phù hợp với việc bạn fải chạy lệnh nhiều lần trong 1 phiên làm việc. dùng cái nào tùy bạn nhé.

(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"))
(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))  
     	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))
PTB (list (+ (* 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 "STT" 
      	"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 (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));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))
);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 toado

Cảm ơn bạn rất nhiều. Lisp của bạn giúp ích cho mình được rất nhiều. Nhưng mình góp ý chân thành rằng ko chỉ riêng mình mà với tất cả các bản vẽ thì tên nút nhiều khi nó được đặt từ trước rồi, cho nên việc tự đặt ra tên nút như thế chưa thực sự phù hợp. Nếu bạn lầm thêm được phần: " Danh ten nut tu dong [ yes/no] " thì lisp này hoàn thiện.

Trong trường hợp ko đánh tự động thì lisp mang chức năng thống kê toạ độ cho người sử dụng, Tên nút là tên do người dùng nhập vào.Và mình đề xuất đổi dòng : (setvar "osmode" 125) thành (setvar "osmode" 15359)

mình ko hiểu về lisp, ko biết viết lisp. Hjxhjx !!! Cảm ơn bạn đã quan tâm giúp đỡ !

Khi nào rỗi bạn có thể sửa giúp mình 1 chút thui được ko ? Vì nếu có được 1 lisp như thế thì nó sẽ júp ích được mình rất nhìu !!!

Command : TDN

Ten nut:

Pick diem:

Ten nut:

Pick diem:

Ten nut:

Pick diem:

Ten nut:

Pick diem:

Vi tri dat bang:

Tên nút là tên mình nhập vào, ko phải là đánh tự động !!!

Cảm ơn bạn nhé !!!

Tháng 8 19, 2009

Bác Thaistreetz ơi! Lisp của bác hay lam, nhung em co mot so y kien nhu nay;

- Trong bảng toạ độ bác cho thêm cột chiều dài các cạnh vào.

- Trong quá trình làm mình phải chọn từng điểm thì lâu qua. Thường thi trong một bản vẽ các điểm nút mình đã đặt tên sẵn. Bác lập sao cho mình chỉ cần "nhập và pick hoặc pick" tên nút đầu tiên thôi là nó tự động chạy cho mình các nút tiếp theo. Như vậy nó sẽ tiện lợi hơn cho tất các các bản vẽ có các tên nút khác nhau.

Tháng 8 19, 2009

@hg: bạn thử nêu sự khác biệt giữa 2 việc này cho tôi xem :

1. mỗi một điểm tọa độ bạn phải 1 lần nhập tên nút.

2. Bạn edit tên của các nút ấy sau khi chạy xong lisp.

nếu việc bạn edit mất quá nhiều thời gian hơn so với việc bạn nhập tên cho từng nút tôi sẽ viết lại cho bạn.

Tất cả các lisp post trên diễn đàn này mọi người đều công khai code. điều đó có nghĩa bạn muốn sửa thế nào cho thích hợp với nhu cầu của ban thì tùy. Riêng tôi khuyến khích bạn làm điều đó. vừa tích lũy kiến thức cho bạn mặt khác vừa để bạn hiểu, tránh đưa ra những yêu cầu (cá nhân tôi cho là) ngớ ngẩn. (Việc này ko khó, tôi cũng chỉ mới bắt đầu học lisp cách đây hơn 2 tuần)

Và lưu ý với bạn. tôi cảm thấy rất khó chịu với bạn vì việc này. trước khi cho rằng lisp của tôi hay mọi người ở đây viết sai thì hãy tự hỏi vì sao người khác chạy được, hay với một bản vẽ này chạy được kết quả tốt còn đối với bản vẽ của bạn thì không. OK?

@Kiukiu: mình đọc đi đọc lại rồi mà vẫn không hiểu bạn muốn nói gì. thật đấy

Nếu bạn chưa vẽ tốt, chưa hiểu những gì cơ bản của cad thì học để nắm vững cad trước đã. sở dĩ mình kết luận điều này là vì những góp ý của bạn ở topic này và topic về lisp tính diện tích.

Tháng 8 20, 2009

@hg: bạn thử nêu sự khác biệt giữa 2 việc này cho tôi xem :
1. mỗi một điểm tọa độ bạn phải 1 lần nhập tên nút.

2. Bạn edit tên của các nút ấy sau khi chạy xong lisp.

nếu việc bạn edit mất quá nhiều thời gian hơn so với việc bạn nhập tên cho từng nút tôi sẽ viết lại cho bạn.

Tất cả các lisp post trên diễn đàn này mọi người đều công khai code. điều đó có nghĩa bạn muốn sửa thế nào cho thích hợp với nhu cầu của ban thì tùy. Riêng tôi khuyến khích bạn làm điều đó. vừa tích lũy kiến thức cho bạn mặt khác vừa để bạn hiểu, tránh đưa ra những yêu cầu (cá nhân tôi cho là) ngớ ngẩn. (Việc này ko khó, tôi cũng chỉ mới bắt đầu học lisp cách đây hơn 2 tuần)

Và lưu ý với bạn. tôi cảm thấy rất khó chịu với bạn vì việc này. trước khi cho rằng lisp của tôi hay mọi người ở đây viết sai thì hãy tự hỏi vì sao người khác chạy được, hay với một bản vẽ này chạy được kết quả tốt còn đối với bản vẽ của bạn thì không. OK?

@Kiukiu: mình đọc đi đọc lại rồi mà vẫn không hiểu bạn muốn nói gì. thật đấy

Nếu bạn chưa vẽ tốt, chưa hiểu những gì cơ bản của cad thì học để nắm vững cad trước đã. sở dĩ mình kết luận điều này là vì những góp ý của bạn ở topic này và topic về lisp tính diện tích.

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é !!!

Tháng 8 21, 2009

Trời ơi! Bác Thaistreetz nóng quá, Bác thông cảm cho em nhé. :bigsmile:

Tháng 8 25, 2009

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

Tháng 8 25, 2009

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" 0)
 (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
(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

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

Tháng 8 26, 2009

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.

Tháng 8 28, 2009

theo mình nên cho thêm 1 lệnh này nữa

(COMMAND "STYLE" "STANDARD" "" 0 "" 1 "" "" "")

Tháng 8 28, 2009

theo mình nên cho thêm 1 lệnh này nữa

(COMMAND "STYLE" "STANDARD" "" 0 "" 1 "" "" "")

Cho vào đâu? và cho vào để làm gì hả bạn? Bản thân textstyle Standard mặc định không dùng font thuộc các bảng mã tiếng việt, font đó chữ cũng rất xấu.

Tháng 9 1, 2009

Chào bạn Thaistreetz.

Mình mới lên diễn đàn còn gà lằm mong các pác thông cảm.

Yêu cầu của mình là tại bảng thống kê toạ nút thì có thêm cột ghi chú, độ rộng cột gấp rưỡi độ rộng cột toạ độ x hoặc y, ở trong không cần ghi chú gì.

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

Tháng 9 1, 2009

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

Tháng 9 1, 2009

Cám ơn Thaistreetz đúng ý tớ rồi :s_big:

Đăng nhập

Lisp ghi tọa độ rất hay mà bị lỗi!

Các bài được khuyến nghị

hhhhgggg 29

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nguyễn hữu vượng 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nguyễn hữu vượng 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hhhhgggg 29

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hhhhgggg 29

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hhhhgggg 29

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hhhhgggg 29

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hhhhgggg 29

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

kiukiu. 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hhhhgggg 29

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

kiukiu. 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hhhhgggg 29

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Thaistreetz 539