@haanh : Nếu bạn định cắt hình tròn bởi 2 điểm trên cung thì dễ r, còn nếu cắt tại 1 điểm như topic đề cập thì sau đó Circle sẽ bị biến thành gì ?
- Có 2 tình huống : 1 là nó sẽ biến thành Pline có 2 segment cong có 2 đầu (gần gần gần gần ... coi như là) chạm nhau
- 2 là biến thành 1 Arc có 2 đầu (gần gần gần gần ... coi như là) chạm nhau
=> CHọn cách 2 cho đơn giản...

@haanh : Nếu bạn định cắt hình tròn bởi 2 điểm trên cung thì dễ r, còn nếu cắt tại 1 điểm như topic đề cập thì sau đó Circle sẽ bị biến thành gì ?
- Có 2 tình huống : 1 là nó sẽ biến thành Pline có 2 segment cong có 2 đầu (gần gần gần gần ... coi như là) chạm nhau
- 2 là biến thành 1 Arc có 2 đầu (gần gần gần gần ... coi như là) chạm nhau
=> CHọn cách 2 cho đơn giản nhé.
Quick :

(defun c:brf ()
(setq cv (car (setq sth (nentselp (setq p (getpoint)) "\nDiem cat doi tuong :"))))
(if (= (cdadr (entget cv)) "CIRCLE")
(command "_break" sth "f" (vlax-curve-getClosestPointTo cv p) (vlax-curve-getClosestPointTo cv (mapcar '- p '(0.01 0.01))))
(command "break" cv p "@")
)
)

"Híc, làm sao có thể xóa được các block được ghi lại theo kiểu B vì nó vẫn tồn tại trong bản vẽ mà ? "(aba)
Đúng như bạn nói khi: khi block vẫn còn hiện hình trên khung nhìn của bản vẽ thì lệnh PU không thể xoá được block đó.Ở bài viết trước,tôi viết chưa đầy đủ:Tạo block một vài bộ phận đã hoàn thiện vào một layer, rồi khóa lớp. Nên đã gây ra sự hiểu...

"Híc, làm sao có thể xóa được các block được ghi lại theo kiểu B vì nó vẫn tồn tại trong bản vẽ mà ? "(aba)
Đúng như bạn nói khi: khi block vẫn còn hiện hình trên khung nhìn của bản vẽ thì lệnh PU không thể xoá được block đó.Ở bài viết trước,tôi viết chưa đầy đủ:Tạo block một vài bộ phận đã hoàn thiện vào một layer, rồi khóa lớp. Nên đã gây ra sự hiểu lầm, đúng ra là phải viết:Tạo block một vài bộ phận đã hoàn thiện vào một layer, rồi khóa lớp hoặc có thể xoá hẳn block đó trên màn hình thì mới rõ nghĩa. Xin lỗi bạn nhé!
Có thể nói gọn lại như sau:
- Khi block không có mặt trên màn hình (do đã bị xoá đi, thì lệnh PU xoá được block ấy).
- Khi block không có mặt trên màn hình (do nó bị ẩn đi khi tắt lớp) thì lệnh PU không xoá được block ấy.
(Khi vẽ 3D, có những phần đã đặt block thì có thể xoá bớt đi hoặc đặt ẩn bằng cách khoá lớp, không cho nó hiện khung nhìn...
Khi gặp trường hợp block đã xoá đi trong khung nhìn của File bản vẽ mà dùng lệnh PU thì ... thôi rồi...)

Không hiểu vì sao một số máy tính không thể write file dcl vào Support (Cad báo stop writting ...gì đó). Có lẽ trường hợp của bạn cũng như vậy (nếu như đúng là không hiện hộp thoại), Mình chữa cháy như thế này: bạn tải lisp dưới đây về chạy lệnh ppp. Cad sẽ hiện lên đường dẫn (tận cùng là Support).
(defun LM:GetSavePath ( / tmp)
(cond
( (setq tmp...

Không hiểu vì sao một số máy tính không thể write file dcl vào Support (Cad báo stop writting ...gì đó). Có lẽ trường hợp của bạn cũng như vậy (nếu như đúng là không hiện hộp thoại), Mình chữa cháy như thế này: bạn tải lisp dưới đây về chạy lệnh ppp. Cad sẽ hiện lên đường dẫn (tận cùng là Support).
(defun LM:GetSavePath ( / tmp)
(cond
( (setq tmp (getvar 'ROAMABLEROOTPREFIX))
(or (eq "\\" (substr tmp (strlen tmp)))
(setq tmp (strcat tmp "\\"))
)
(strcat tmp "Support")
)
( (setq tmp (findfile "ACAD.pat"))
(setq tmp (vl-filename-directory tmp))
(and (eq "\\" (substr tmp (strlen tmp)))
(setq tmp (substr tmp (1- (strlen tmp))))
)
(princ tmp)
)
)
)
(defun C:ppp() (LM:GetSavePath))

@Giang : không ai nghi ngờ sự nhiệt tình của bác Bình, vậy mà .. Bảo sao ...
Mình nhắc lại với riêng G lần nữa, nếu sau này bạn có cần sự giúp đỡ của CV, hãy suy nghĩ về cách đặt vấn đề của mình. Những bài thiếu rõ ràng hoặc chứng tỏ sự hời hợt sẽ bị xóa thẳng tay.

Code nhanh cho bạn lisp này, khi hỏi d thì bạn nhập hoặc đo d như thế nào tùy cách bạn định...

@Giang : không ai nghi ngờ sự nhiệt tình của bác Bình, vậy mà .. Bảo sao ...
Mình nhắc lại với riêng G lần nữa, nếu sau này bạn có cần sự giúp đỡ của CV, hãy suy nghĩ về cách đặt vấn đề của mình. Những bài thiếu rõ ràng hoặc chứng tỏ sự hời hợt sẽ bị xóa thẳng tay.

Code nhanh cho bạn lisp này, khi hỏi d thì bạn nhập hoặc đo d như thế nào tùy cách bạn định nghĩa khoảng cách Text, nhập sai thì k nên trách lisp làm việc sai ý bạn. Khi kiểm tra nó sẽ so sánh INSERTION POINT
- Khi hỏi = d hay <=d, nếu bạn đánh < hoặc space thì tự động hiểu là <= d thì nối. Nếu đánh chữ nào khác thì tính là bằng (TUYỆT ĐỐI)


(defun c:test(/ lstObj d ans ins! tObj tam isFound lstObj lstRs)
(setq lstObj (mapcar 'vlax-ename->vla-object (acet-ss-to-list (ssget (list (cons 0 "*TEXT")))))
d (getdist "\nKhoang cach :")
ans (getstring "\n<=d hay =d ? :")
)
(defun ins!(e)(vlax-get e 'Insertionpoint))
(while (setq tObj (car lstObj))
(setq tam (ins! tObj))
(cond ((setq isFound (vl-member-if '(lambda(x)(and (setq kc (- (distance (ins! x) tam) d))(if (wcmatch ans ",<")(not (minusp kc))(zerop kc))))
(setq lstObj (cdr lstObj))))
(setq isFound (vl-sort isFound '(lambda(x y)(< (distance (ins! x) tam)(distance (ins! y) tam))))
lstObj (vl-remove (car isFound) lstObj)
lstRs (vl-sort (list tobj (car isFound)) '(lambda(x y)(< (car (ins! x))(car (ins! y))))))
(vla-put-textstring (car lstRs)
(strcat
(vla-get-textstring (car lstRs)) ","
(vla-get-textstring (last lstRs))
)
)
(vla-delete (last lstRs))
)
)
)
)


- Mình cũng k kiểm tra text của bạn là số hay không đâu, dù công việc đó vô cùng đơn giản, nhưng bạn yêu cầu là text quét chọn all
- Mình cũng nói luôn là bạn định nối các text theo khoảng cách phương x thì sẽ sai bét. Tự bạn tìm hiểu nguyên nhân nhé :")

Chúc bạn may mắn

Chờ các bác mãi kg thấy đâu (có lẽ đang mãi mê với mục &quot;so sánh bv&quot;), mình mày mò viết thêm một đoạn code cho nó làm nốt cái cv cắt đối tượng.

Lệnh là vdtg4. Nói chung giai đoạn tìm giao đã chạy ổn và khá nhanh, nhưng gđ cắt đối tượng mình chưa yên tâm lắm.
- Một là : PP cắt như thế có ổn kg
- Hai là : Kg hiểu sao thời gian ngày càng chậm (code trong hàm...

Chờ các bác mãi kg thấy đâu (có lẽ đang mãi mê với mục &quot;so sánh bv&quot;), mình mày mò viết thêm một đoạn code cho nó làm nốt cái cv cắt đối tượng.

Lệnh là vdtg4. Nói chung giai đoạn tìm giao đã chạy ổn và khá nhanh, nhưng gđ cắt đối tượng mình chưa yên tâm lắm.
- Một là : PP cắt như thế có ổn kg
- Hai là : Kg hiểu sao thời gian ngày càng chậm (code trong hàm breaktheodsdt1)
Nhờ các bạn xem và tư vấn giúp 2 vđ trên.
Mình đưa bv đủ thứ đt để các bạn thử. Có thể xóa bốt đi nếu cần.
http://www.cadviet.com/upfiles/3/37170_catdoituong2070.dwg
Xin cám ơn

Hề hề hề,
Bạn nói không nối được là sao?? Hay bạn chưa thử??? Mình đã check trên bản vẽ bạn gửi thấy nó nối lia chia mà.
Tuy nhiên nó còn lỗi khi bản vẽ của bạn có chứa các text trùng nhau.
Mình đã fix lại lỗi này trong lisp đưới đây và test lại trên bản vẽ bạn gửi thì đạt kết quả >99%. Chỉ còn một số text chưa được nối do chùng trùng nhau quá hớp mà lisp...

Hề hề hề,
Bạn nói không nối được là sao?? Hay bạn chưa thử??? Mình đã check trên bản vẽ bạn gửi thấy nó nối lia chia mà.
Tuy nhiên nó còn lỗi khi bản vẽ của bạn có chứa các text trùng nhau.
Mình đã fix lại lỗi này trong lisp đưới đây và test lại trên bản vẽ bạn gửi thì đạt kết quả >99%. Chỉ còn một số text chưa được nối do chùng trùng nhau quá hớp mà lisp không biết chọn text nào để nối cũng như các cụm text mà hai text cách nhau quá xa (lớn hơn kích thước textbox). Trường hợp này bạn phải xử lý bằng tay thôi.


Đây là hình ảnh kết quả. Chú ý cái vòng tròn màu đỏ.
http://www.cadviet.com/upfiles/3/5194_test.jpg
http://www.cadviet.com/upfiles/3/5194_test2.jpg

Bạn chú y là líp viết cho các bản vẽ có cấu tạo các text đúng như bản vẽ bạn đã gửi. Nếu text có cấu tạo khác thì mình không đảm bảo lisp sẽ làm việc đúng.

Mình viết cho bạn đây rùi đây theo phương án đơn giản hơn là phương án số 2 của bạn
Bạn đóng điểm gốc thành 1 block và copy vào các điểm gốc mà bạn chọn
Khi đó bạn không cần pick lần lượt từng điểm gốc nữa nhé
Lệnh: CPN chuyển phát nhanh

;; Free lisp code from...

Mình viết cho bạn đây rùi đây theo phương án đơn giản hơn là phương án số 2 của bạn
Bạn đóng điểm gốc thành 1 block và copy vào các điểm gốc mà bạn chọn
Khi đó bạn không cần pick lần lượt từng điểm gốc nữa nhé
Lệnh: CPN chuyển phát nhanh

;; Free lisp code from CADViet.com
;;;;;;;;;;;;;;; Chuyen phat nhanh doi tuong theo block - edit by Mathan
(defun c:CPN ( )
(command "undo" "be")
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nChon vung doi tuong: ")
(setq vungdt (ssget))
(princ "\n Chon doi tuong block goc toa do cua vung vua copy ")
(setq blockgoc (ssget (list (cons 0 "INSERT"))))
(setq goc1 (cdr (assoc 10 (entget (ssname blockgoc 0)))))
(setq ten (cdr (assoc 2 (entget (ssname blockgoc 0)))))
(setq sset (ssget "_X" (list (cons 0 "INSERT")(cons 2 ten))))

(setq n (sslength sset))
(setq i 0)
(while (< i n)
(setq Ent (ssname sset i))
(setq dgock (cdr (assoc 10 (entget ENT))))
(if (= goc1 dgock) (princ "\n Trung diem goc ")
(command "COPY" vungdt "" goc1 dgock)
)

(setq i (+ i 1))
)
(setvar "osmode" os)
(command "undo" "end")


(princ)
)

Theo em thì do bác NTD này ko diễn đạt đúng ý đồ thôi, em là một thợ vẽ nên thường dụng tới thằng này lắm, khi có một mặt bằng và muốn vẽ 4 mặt đứng xung quanh: thay vì phải copy ra một mặt bằng nữa rồi vẽ xong mặt đứng này lại phải quay cái mặt bằng vừa copy ra để vẽ tiếp cái khác===> vừa nặng máy vừa khó đối chiếu mặt đứng với MB
Vì vậy sữ dụng lệnh Plan để...

Theo em thì do bác NTD này ko diễn đạt đúng ý đồ thôi, em là một thợ vẽ nên thường dụng tới thằng này lắm, khi có một mặt bằng và muốn vẽ 4 mặt đứng xung quanh: thay vì phải copy ra một mặt bằng nữa rồi vẽ xong mặt đứng này lại phải quay cái mặt bằng vừa copy ra để vẽ tiếp cái khác===> vừa nặng máy vừa khó đối chiếu mặt đứng với MB
Vì vậy sữ dụng lệnh Plan để vẽ 4 mặt đứng nằm xung quanh cái MB. có lẽ đây là "View port bên Model" của bác ấy?!
Em xin góp một code để giảm phiền toái khi phải sữ dụng Plan nhiều. Lisp yêu cầu chọn đối tượng để zoom object và nhập vào góc quay. lệnh AS để thay đổi View, lệnh ASS để trở về Plan của UCS World

(defun c:AS(/ goc dtz)
(setq dtz (ssget)
goc (getreal "\nangle: "))
(command "ucs" "z" (* -1 goc) "")
(command "plan" "")
(command "zoom" "o" dtz "")
(princ)
)
(defun c:AsS()
(command "ucs" "")
(command "plan" "")
(princ)
)

Yêu cầu đơn giản nhưng mô tả rõ ràng, mình rất thích
Của bạn :

(defun c:reca(/ dt a p1 p2)(vl-load-com) ;free @ketxu
(setq dt (cond ((getreal "\nNhap dien tich hoac space de pick Pline"))
((not (princ "\nChon Pline :")))
((vla-get-area (vlax-ename->vla-object (ssname (ssget ":S" (list (cons 0 "*POLYLINE"))) 0))))
)
)
(vl-cmdf ".rectang" (setq p1 (getpoint...

Yêu cầu đơn giản nhưng mô tả rõ ràng, mình rất thích
Của bạn :

(defun c:reca(/ dt a p1 p2)(vl-load-com) ;free @ketxu
(setq dt (cond ((getreal "\nNhap dien tich hoac space de pick Pline"))
((not (princ "\nChon Pline :")))
((vla-get-area (vlax-ename->vla-object (ssname (ssget ":S" (list (cons 0 "*POLYLINE"))) 0))))
)
)
(vl-cmdf ".rectang" (setq p1 (getpoint "\nP1 :")) "_non" (strcat "@" (rtos (setq a (distance p1 (getpoint p1 "\nP2")))) ","(rtos (/ dt a))))
)

Code này có thể Zoom center và chọn lại scale của view trước khi xoay, dựa vào Viewsize và chọn center của view
Còn về UCS thay đổi theo View mới, theo mình hợp lý hơn là vẫn theo view trước đó, vì khi này ta ghi dim text ko bị đảo lộn.
Rengen thì mình pó tay, vì dùng lệnh Plan của CAD thì nó mặt định đi theo rồi. hic

(defun c:AS(/ p goc vs)
(setq p (getpoint "\nSpecify Center")

>>

Code này có thể Zoom center và chọn lại scale của view trước khi xoay, dựa vào Viewsize và chọn center của view
Còn về UCS thay đổi theo View mới, theo mình hợp lý hơn là vẫn theo view trước đó, vì khi này ta ghi dim text ko bị đảo lộn.
Rengen thì mình pó tay, vì dùng lệnh Plan của CAD thì nó mặt định đi theo rồi. hic

(defun c:AS(/ p goc vs)
(setq p (getpoint "\nSpecify Center")
goc (getreal "\nangle: ")
vs (getvar "viewsize")
p (trans p 1 0))
(command "ucs" "z" (* -1 goc) "")
(command "plan" "")
(command "zoom" "c" (trans p 0 1) vs)
(princ)
)

Đây là Lisp mình sưu tập được bạn dùng thử, mình dùng thì thấy rất đúng yêu cầu của bài rùi

;(setq thu 1)
(defun c:ckt ()
(setq thu 1)
(while (< thu 4)
(princ "\n Chon duong giong:")
(princ "\n Chon cac duong kich thuoc:")
(setq chon2 (ssget))
(setq ktra1 (getstring "n\Lua chon: giong Duoi (D), giong Tren (T), theo duong thang (V):"))


(if (OR (=...

Đây là Lisp mình sưu tập được bạn dùng thử, mình dùng thì thấy rất đúng yêu cầu của bài rùi

;(setq thu 1)
(defun c:ckt ()
(setq thu 1)
(while (< thu 4)
(princ "\n Chon duong giong:")
(princ "\n Chon cac duong kich thuoc:")
(setq chon2 (ssget))
(setq ktra1 (getstring "n\Lua chon: giong Duoi (D), giong Tren (T), theo duong thang (V):"))


(if (OR (= ktra1 "G") (= ktra1 "g"))
(progn
(setq chon1 (entsel "\n Chon duong giong:"))
(setq chon1 (car chon1))
(setq ktra (cdr(assoc 0(entget chon1))))
(if (= ktra "LINE")

(progn

(setq DAU (cdr(assoc 10(entget chon1))))
(setq CUOI (cdr(assoc 11(entget chon1))))
(giong)
(setq thu (+ thu 1))

)
) ;-----------ket thuc if 1
; (if (= ktra "LWPOLYLINE")
;(progn
; (setq danhsach nil)
; (setq j 1)
; (setq eg (entget chon1))
; (setq DAU (cdr(assoc 10(entget chon1))))
; (while (/= DAU nil)
; (setq danhsach (append danhsach DAU))
; (setq j (+ j 1))
;; (setq cu (list 10 (car DAU) (cadr DAU) 0))
; (setq moi (list 11 (car DAU) (cadr DAU) 0))
; (setq eg (subst moi cu eg))
; )

;(setq i 1)
;(setq DAU (nth i danhsach))
;(setq CUOI (nth (+ i 1) danhsach))
;(giong)




)
) ;--------ket thuc if2

(if (OR (= ktra1 "D") (= ktra1 "d"))
(progn
(setq DAU (getpoint "\n Chon diem lam moc :"))
(setq CUOI (polar DAU 0 10))
(giong)
(setq thu (+ thu 1))
)
);-------Dong if
(if (OR (= ktra1 "V") (= ktra1 "v"))
(progn
(setq DAU (getpoint "\n Chon diem dau :"))
(setq CUOI (getpoint "\n Chon diem thu hai :"))
(giong)
(setq thu (+ thu 1))
)
);-------Dong if
(if (OR (= ktra1 "T") (= ktra1 "t"))
(progn
(setq DAU (getpoint "\n Chon diem lam moc :"))
(setq CUOI (polar DAU 0 1))
(setq x1 (car DAU))
(setq y1 (cadr DAU))
(setq x2( car CUOI))
(setq y2 (cadr CUOI))
(setq kq1 (/ (- y1 y2) (- x1 x2)))

(setq k 0)
(while (setq ENT (ssname chon2 k)) ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p1))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p2))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
(setq eg2 (entget ENT))
(setq tdcud (list 11 (car p1) (cadr p1) 0))
(setq tdcuc (list 10 (car p2) (cadr p2) 0))
(setq tdmoid (list 11 xd yd 0))
(setq tdmoic (list 10 xc yc 0))

; (setq caodo (rtos caodo))
;(setq ten (cons 1 caodo))
(setq eg2 (subst tdmoid tdcud eg2))
(setq eg2 (subst tdmoic tdcuc eg2))
(entmod eg2)
(SETQ K (+ K 1))
)
(setq thu (+ thu 1))
)
);dong if
)
(if (>= thu 4)
(progn
(textscr)
(princ "\n Xin lien he sdt: 0987255580")
)
)

)
(defun giong ()
(setq x1 (car DAU))
(setq y1 (cadr DAU))
(setq x2( car CUOI))
(setq y2 (cadr CUOI))
(setq kq1 (/ (- y1 y2) (- x1 x2)))

(setq k 0)
(while (setq ENT (ssname chon2 k)) ;--------> duyet tung thang 1
(setq p1 (cdr(assoc 11(entget ENT))))
(setq p2 (cdr(assoc 10(entget ENT))))
(setq p3 (cdr(assoc 14(entget ENT))))
(setq p4 (cdr(assoc 13(entget ENT))))
(setq xd (car p3))
(setq yd (+ (* (- xd x1) kq1) y1))
(setq xc (car p4))
(setq yc (+ (* (- xc x1) kq1) y1))
;--------------------------giong duoi---------------------------------------------
(setq eg2 (entget ENT))
(setq tdcud (list 14 (car p3) (cadr p3) 0))
(setq tdcuc (list 13 (car p4) (cadr p4) 0))
(setq tdmoid (list 14 xd yd 0))
(setq tdmoic (list 13 xc yc 0))

; (setq caodo (rtos caodo))
;(setq ten (cons 1 caodo))
(setq eg2 (subst tdmoid tdcud eg2))
(setq eg2 (subst tdmoic tdcuc eg2))
(entmod eg2)
(SETQ K (+ K 1))
)
)

Tương tự như công năng của nhóm lện trên em down trên cadviet 1 nhóm lệnh sau chống lại LayOn & LayThw & chống lại cả UNISOLATEOBJECTS nữa


(defun c:E5 (/ SSet Count Elem)

(defun Dxf (Id Obj)
(cdr (assoc Id (entget Obj)))
);end Dxf

(prompt "\nSelect object(s) to hide: ")
(cond
((setq SSet (ssget))
(repeat (setq Count (sslength SSet))
(setq Count (1-...

Tương tự như công năng của nhóm lện trên em down trên cadviet 1 nhóm lệnh sau chống lại LayOn & LayThw & chống lại cả UNISOLATEOBJECTS nữa


(defun c:E5 (/ SSet Count Elem)

(defun Dxf (Id Obj)
(cdr (assoc Id (entget Obj)))
);end Dxf

(prompt "\nSelect object(s) to hide: ")
(cond
((setq SSet (ssget))
(repeat (setq Count (sslength SSet))
(setq Count (1- COunt)
Elem (ssname SSet Count))
(if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
(if (Dxf 60 Elem)
(entmod (subst '(60 . 1) (assoc 60 (entget Elem)) (entget Elem)))
(entmod (append (entget Elem) (list '(60 . 1))))
)
(prompt "\nEntity on a locked layer. Cannot hide this entity. ")
);end if
);end repeat
)
);end cond
(princ)
);end c:InVis

Hi. Chúc bạn vui lới LISP mà mình chế này
Code lisp trên diễn đàn rất nhiều bạn cứ mày mò học lỏm và sửa chữa cũng vui lắm đó.hi


;; free lisp from cadviet.com
;;; Edit by mathan
----------------------------------------------
(defun C:tkd ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(if (not h) (setq h 1))
(setq...

Hi. Chúc bạn vui lới LISP mà mình chế này
Code lisp trên diễn đàn rất nhiều bạn cứ mày mò học lỏm và sửa chữa cũng vui lắm đó.hi


;; free lisp from cadviet.com
;;; Edit by mathan
----------------------------------------------
(defun C:tkd ()
(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 TP (getint (strcat "\nSo chu so thap phan :")))
(setq tapx '() tapy '() stt '())

;;; Phan dim
(setq ktra "OK")
(While (= ktra "OK")
(setvar "osmode" 125)
(setq DD (getpoint"\nPick diem dau"))
(setq TDD (getstring"\nNhap ten diem dau:"))
(setq DC (getpoint"\nPick diem cuoi"))
(setq TDC (getstring"\nNhap ten diem cuoi:"))
(setvar "osmode" 0)

(setq kc (distance DD DC))

(setq textdim (rtos kc 2 tp))
(setq textdiem (strcat TDD "-" TDC))
(setq ghichu "Do thuc te")
(command "_DIMALIGNED" DD DC (getpoint"\nDiem dat dim"))
(setq ktra (getstring"\nBan muon tiep tuc - dung lai :"))
(if (= ktra "S") (setq ktra "NOT OK") (setq ktra "OK"))

(setq
tapx (append tapx (list textdim))
tapy (append tapy (list ghichu))
stt (append stt (list textdiem))
);setq
);;end while

;;;;;;;;;;;;; Phan lap bang thong ke
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuat bang toa do? <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di 10
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 "Diem do"
"text" "m" p22 h 0 "Chieu dai"
"text" "m" p33 h 0 "Ghi chu"
"text" "m" pTB (* 1.3 h) 0 "Bang thong ke chieu dai dim")
(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 by Thaistreetz - Edit by Mathan")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do


Chúc công việc của bạn sẽ thuận lợi hơn với lisp này.