Viết lisp theo yêu cầu [phần 2]

Tháng 1 18, 2011

Xin lỗi bạn ketxu có sai sót tí, mình đã bỏ mất phần khai báo biến h của bạn.Mình sửa lại trong code bài cũ rồi, bạn lấy lại nhé.
Nhớ là tạm thời khi dùng trong Text Style bạn để h = 0 đi, để các lệnh Text đúng khi có khai báo h text trong câu lệnh (lý do thì nêu ở bài đó rồi).Nếu điều này quá phiền toái thì mình sẽ sửa giúp bạn sau

Còn tỉ lệ thì bạn chỉ đánh số mẫu thôi.Ví dụ 1/100 thì bạn đánh 100 ở mục yêu cầu tỉ lệ nhé

Cảm ơn bạn Ketxu nhé! Mình đã sử dụng được rùi.

Phần tỷ lệ đó phải đúng với tỷ lệ của bản vẽ mình cần tính diện tích.

Vấn đề đặt ra (hỏi ngoài chủ đề này) là làm sao để biết bản vẽ đó tỷ lệ bao nhiêu để thiết lập tỷ lệ bản vẽ cho lip này nhỉ?

Còn với Text Style thì mình ko thấy phiền chút nào cả, nhưng nếu bạn có thời gian để sửa nó thì còn gì bằng. :)

Tháng 1 18, 2011

Cảm ơn bạn Ketxu nhé! Mình đã sử dụng được rùi.
Phần tỷ lệ đó phải đúng với tỷ lệ của bản vẽ mình cần tính diện tích.

Vấn đề đặt ra (hỏi ngoài chủ đề này) là làm sao để biết bản vẽ đó tỷ lệ bao nhiêu để thiết lập tỷ lệ bản vẽ cho lip này nhỉ?

Còn với Text Style thì mình ko thấy phiền chút nào cả, nhưng nếu bạn có thời gian để sửa nó thì còn gì bằng. :)

1.Chắc chắn một điều khi đo 1 cái gì đó trên bản vẽ KThuật ta phải biết tỉ lệ để tìm ra kích thước thực rồi.Để tìm ra tỉ lệ thì lại còn phụ thuộc vào ý tưởng lúc vẽ ban đầu.Nếu bản vẽ đó là của bạn, bạn vẽ tỉ lệ bao nhiêu thì hẳn bạn đã biết.Nếu bản ve đó của người khác, bạn đành phải nhìn số liệu Dim của người ta để biết thôi.Tất nhiên điều này chỉ đúng khi đó là dim với giá trị chân thực, k phải dim đã độ,chế ed linh tinh xoèng :)

2.Vấn đề h text trong text style đã được sửa, bạn không cần nhập nữa, nó sẽ lấy theo h hiện hành, bất kể giá trị đó có bằng 0 hay khác 0

Lisp ban đầu của bác Tue_N dùng command text, ketxu đã đưa thêm hàm viết text của bác ssg vào, thêm 1 chút phần Justify Middle, hy vọng lần này bạn hài lòng

; free lisp from cadviet.com @Thaistreetz
;Tinh Dt co mien khoet rong ben trong va lap bang
(defun c:dt2(/ d h1 h2 wf tl1 k tdt P1 P2 P3 P4 P5 P6 P7 P8 PT PT1 P9 P10 P11 P12 P13 frome toe cur dt S)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode")) 
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2)) 
(if (not tl) (setq tl 1))
(setq tl1 (getreal (strcat "\nTy le ban ve : 1/")))
(if tl1 (setq tl tl1))
(setq k 0 tdt 0)
(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq     P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
       "pline" P1 P4 ""
) 
(wtxt_m "Bang Thong Ke DT" P6 )
(wtxt_m "STT" P7)
(wtxt_m "Dien tich (m2)" P8)
(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(command "erase" ss "")
(setq k (+ 1 k))
(wtxt_m (rtos k 2 0) pt1)
(setq PT (list (car P3) (cadr P3))
   P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
   P9 (list (car PT) (- (cadr P3)(* 3 h)))
   P10 (list (car P1) (cadr P9))
   P11 (list (car P2) (cadr P9))
   P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
   P13 (list (car P8) (cadr P12))
   );setq
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command "cecolor"4 "-boundary" pt1 "");; boundary
(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary
(setq cur frome	ss (ssadd) S 0)
(while 	(not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq cur (entnext cur) ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area") S (+ S dt))
);while
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq S (* (+ S (* dt 2)) tl (/ tl 500 500)) tdt (+ s tdt))
(setvar "CEColor" lacol)
(command "pline" PT P2 P5 P3 "C"
 "pline" P1 P4 "")
( wtxt_m (rtos k 2 0) P7)
 (wtxt_m (rtos s 2 2) P8)
(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo...")))
);while
(command "erase" ss "")
(setq ss nil)
(setvar "DIMZIN" ladin)
(command     "pline" P3 P9 P11 P5 "C"
       "pline" P10 P4 "")
       (wtxt_m "Tong" P12)
       (wtxt_m (rtos tdt 2 2) P13)
(setvar "OSMODE" laos)
(command "undo" "end")
(setvar "cmdecho" 1)
)

;;free function @ssg
(defun wtxt_m(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))

Tháng 1 18, 2011

..........

Lisp ban đầu của bác Tue_N dùng command text, ketxu đã đưa thêm hàm viết text của bác ssg vào, thêm 1 chút phần Justify Middle, hy vọng lần này bạn hài lòng

...................

; free lisp from cadviet.com @Tue_NV
;Tinh Dt co mien khoet rong ben trong va lap bang
(defun c:dt2(/ d h1 h2 wf tl1 k tdt P1 P2 P3 P4 P5 P6 P7 P8 PT PT1 P9 P10 P11 P12 P13 frome toe cur dt S)
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode")) 
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2)) 
(if (not tl) (setq tl 1))
(setq tl1 (getreal (strcat "\nTy le ban ve : 1/")))
(if tl1 (setq tl tl1))
(setq k 0 tdt 0)
(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq     P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
       "pline" P1 P4 ""
) 
(wtxt_m "Bang Thong Ke DT" P6 )
(wtxt_m "STT" P7)
(wtxt_m "Dien tich (m2)" P8)
(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(command "erase" ss "")
(setq k (+ 1 k))
(wtxt_m (rtos k 2 0) pt1)
(setq PT (list (car P3) (cadr P3))
   P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
   P9 (list (car PT) (- (cadr P3)(* 3 h)))
   P10 (list (car P1) (cadr P9))
   P11 (list (car P2) (cadr P9))
   P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
   P13 (list (car P8) (cadr P12))
   );setq
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command "cecolor"4 "-boundary" pt1 "");; boundary
(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary
(setq cur frome	ss (ssadd) S 0)
(while 	(not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq cur (entnext cur) ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area") S (+ S dt))
);while
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq S (* (+ S (* dt 2)) tl (/ tl 500 500)) tdt (+ s tdt))
(setvar "CEColor" lacol)
(command "pline" PT P2 P5 P3 "C"
 "pline" P1 P4 "")
( wtxt_m (rtos k 2 0) P7)
 (wtxt_m (rtos s 2 2) P8)
(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo...")))
);while
(command "erase" ss "")
(setq ss nil)
(setvar "DIMZIN" ladin)
(command     "pline" P3 P9 P11 P5 "C"
       "pline" P10 P4 "")
       (wtxt_m "Tong" P12)
       (wtxt_m (rtos tdt 2 2) P13)
(setvar "OSMODE" laos)
(command "undo" "end")
(setvar "cmdecho" 1)
)

;;free function @ssg
(defun wtxt_m(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))

Ketxu "soi" Lộn rồi bạn ơi. Tue_NV chỉ tư vấn cho bạn Thai sờ trét hoàn thành cái Lisp này.

Đây này :

http://www.cadviet.com/forum/index.php?sho...12432&st=20

Việc sử dụng các hàm command và hàm entmake đê tạo đối tượng. Ưu nhược điểm và mỗi hàm thì đã có các bài viết về nó. Các bạn tìm đọc nhé. Riêng mình thích sử dụng các hàm Entmake nhiều hơn vì các ưu điểm của nó và cũng sử dụng hàm command vì nó ngắn gọn hơn

Tháng 1 18, 2011

Hề hề..Vô cùng xin lỗi bác Sì Trít và bác Tuệ ^^ E nhớ nhầm vì topic này Lisp tính diện tích với lại topic frome toe bác Tuệ hỏi chọn lại số đối tượng sau lệnh Boundary nên bị loạn..Trong lúc tổng hợp có sơ suất, mong các bác bỏ qua ^^ Thửa nào bác Đường Thái Lan vào rồi ra, hok nói 1 câu,mần e chột dạ quá :")

Tháng 1 19, 2011

Do lệnh hatch trong lisp ban đầu của bạn còn thiếu thông số chọn điểm trong vùng Hatch đó mà
Bạn sửa thành như thế này nhé :
(defun c:Ht ()
(command "-Bhatch" "P" "ANSI31" "300" "")
(while (< 0 (getvar "CMDACTIVE"))	(command pause));end while
(vl-cmdf "change" "L" "" "P" "LA" "00-09hatch" "")
)
Góp ý với bạn : ngoài tiếng tks kèm theo lời yêu cầu,bạn có thể dùng nút thanks để động viên hoặc để báo cho người giúp bạn biết là bạn đã ngó qua cái phần người ta đáp ứng nhu cầu của bạn.:")

cảm ơn lời góp ý của bác...e sẽ để ý hơn...thanks bác!!! mà bác có thể xem giúp e cái lisp dim (d_dc_da_qd_dg.lsp) ở trên với được ko...e ko thể dùng được...đánh lệnh d hay da thì ko thấy có ji.?

Tháng 1 19, 2011

A Bình sửa lại CODE dum em với!

Chào bạn truongthanh,

Quả thực áy náy vì chưa hiểu bạn bảo mình sửa giùm cái líp nào nữa??? Do mình cũng nghịch hơi nhiều nên giờ chả biết cái chi vào cái mô nữa.... Giá bạn post cái líp đó lên luôn thì hay biết mấy....

Nhưng vấn đề bạn yêu cầu thực ra chả cần ai giúp mà bạn có thể tự làm được đó. Rất đơn giản, bạn cứ dùng notepad mở cái file lisp đó ra và tìm đến đúng cái dòng code nào có cái đoạn NHAP CAO DO THIET KE DIEM thì bạn xóa chữ NHAP đi và thay nó bằng chữ CHON là xong mà. Chỉ cần bạn lưu ý chớ xóa hay thêm bất kỳ cái gì khác là Ok.

Rất mong bạn thông cảm và cố gắng thử một phát xem sao....

Tháng 1 19, 2011

Chào bạn truongthanh,
Quả thực áy náy vì chưa hiểu bạn bảo mình sửa giùm cái líp nào nữa??? Do mình cũng nghịch hơi nhiều nên giờ chả biết cái chi vào cái mô nữa.... Giá bạn post cái líp đó lên luôn thì hay biết mấy....

Nhưng vấn đề bạn yêu cầu thực ra chả cần ai giúp mà bạn có thể tự làm được đó. Rất đơn giản, bạn cứ dùng notepad mở cái file lisp đó ra và tìm đến đúng cái dòng code nào có cái đoạn NHAP CAO DO THIET KE DIEM thì bạn xóa chữ NHAP đi và thay nó bằng chữ CHON là xong mà. Chỉ cần bạn lưu ý chớ xóa hay thêm bất kỳ cái gì khác là Ok.

Rất mong bạn thông cảm và cố gắng thử một phát xem sao....

Hix hix! Đoạn CODE đó nằm ở trang trước trang này đó anh, có lẽ nó bị trôi đi nên anh không thấy, em gửi lại link sau:

http://www.cadviet.com/forum/index.php?sho...st&p=127495

hiện giờ lisp yêu cầu mình "NHẬP", giờ em muốn "CHỌN" trên màn hình! Chứ mở file LISP sửa chữ đó thì em làm được nhưng lisp ko khác gì hết!hehe! :) !Nhờ anh giúp dùm em với!

Tháng 1 19, 2011

Hix hix! Đoạn CODE đó nằm ở trang trước trang này đó anh, có lẽ nó bị trôi đi nên anh không thấy, em gửi lại link sau:
http://www.cadviet.com/forum/index.php?sho...st&p=127495

hiện giờ lisp yêu cầu mình "NHẬP", giờ em muốn "CHỌN" trên màn hình! Chứ mở file LISP sửa chữ đó thì em làm được nhưng lisp ko khác gì hết!hehe! :) !Nhờ anh giúp dùm em với!

Hề hề hê,

Chào bạn Truongthanh,

Có phải bạn muốn thế này không???

;tinh cao do cong
(defun C:cdc (/ s1 L1 i1 txt i n k m t1 t2 t3 m1 s2 p2 p3 p4 p5 p6 )
;;;;;(setq s1 (getreal "\nCAO DO DAY CONG DIEM DAU: "))
;;;;;(setq L1 (getreal "\nCHIEU DAI CONG: "))
;;;;;(setq i1 (getreal "\nDO DOC CONG: "))
(setq s1 (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do day cong diem dau")))))))
(setq txt (cdr (assoc 1 (entget (car (entsel "\n Chon text chuan " )))))
i 1
n (strlen txt)
k nil
)
(while ((setq kt (substr txt i 1))
(if (= kt "-")
(progn
(setq k i
i n)
)
)
(setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
i 1
m nil
)
(while ((setq kt (substr t2 i 1))
(if (= kt "-")
(progn
(setq m i
i n)
)
)
(setq i (1+ i))
)
(if m
(progn
(setq t3 (substr t2 (+ m 3) n))
(setq t2 (substr t2 1 (- m 2)))
)
)
)
)
(setq L1 (atof t2)
i1 ( / (atof t3) 1000)
)
(setq m1 (atof (cdr (assoc 1 (entget (car (entsel "\nCHON TEXT CAO DO THIET KE DIEM: ")))))))
(setq s2 (- s1 (* L1 i1)))
(setq p2 (getpoint "\nchon diem cuoi doan cong"))
(setq p3 (getpoint "\nchon diem dat text"))
(if (>= (car p3) (car p2))
(progn
(setq p4 (polar p3 (/ pi 4) 1))
(setq p5 (polar p3 0 6))
(setq p6 (polar p3 (/ (- 0 pi) 4) 1))
(setvar "snapmode" 0)
(setvar "osmode" 0)
(command ".text" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tl" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
)
(progn
(setq p4 (polar p3 (* (/ pi 4) 3) 1))
(setq p5 (polar p3 pi 6))
(setq p6 (polar p3 (* (/ (- 0 pi) 4) 3) 1))
(setvar "snapmode" 0)
(setvar "osmode" 0)
(command ".text" "j" "r" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tr" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
)
)

(setvar "snapmode" 0)
(setvar "osmode" 16383)

(princ)
)

Hề hề hề,

Bạn thông cảm vì mình không hiểu hết ý của bạn. Mình sửa như vầy thì lisp sẽ chỉ chạy đúng nếu cái text cao độ bạn chọn là Text, còn không đảm bảo đúng khi text đó là Mtext bạn nhé...

Nếu có gì chưa đúng bạn lại post lên nhé.

Chúc bạn vui.

Tháng 1 19, 2011

Hề hề hê,

Chào bạn Truongthanh,

Có phải bạn muốn thế này không???

;tinh cao do cong
(defun C:cdc (/ s1 L1 i1 txt i n k m t1 t2 t3 m1 s2 p2 p3 p4 p5 p6 )
;;;;;(setq s1 (getreal "\nCAO DO DAY CONG DIEM DAU: "))
;;;;;(setq L1 (getreal "\nCHIEU DAI CONG: "))
;;;;;(setq i1 (getreal "\nDO DOC CONG: "))
(setq s1 (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do day cong diem dau")))))))
(setq txt (cdr (assoc 1 (entget (car (entsel "\n Chon text chuan " )))))
i 1
n (strlen txt)
k nil
)
(while (<= i n)
(setq kt (substr txt i 1))
(if (= kt "-")
(progn
(setq k i
i n)
)
)
(setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
i 1
m nil
)
(while (<= i n)
(setq kt (substr t2 i 1))
(if (= kt "-")
(progn
(setq m i
i n)
)
)
(setq i (1+ i))
)
(if m
(progn
(setq t3 (substr t2 (+ m 3) n))
(setq t2 (substr t2 1 (- m 2)))
)
)
)
)
(setq L1 (atof t2)
i1 ( / (atof t3) 1000)
)
(setq m1 (atof (cdr (assoc 1 (entget (car (entsel "\nCHON TEXT CAO DO THIET KE DIEM: ")))))))
(setq s2 (- s1 (* L1 i1)))
(setq p2 (getpoint "\nchon diem cuoi doan cong"))
(setq p3 (getpoint "\nchon diem dat text"))
(if (>= (car p3) (car p2))
(progn
(setq p4 (polar p3 (/ pi 4) 1))
(setq p5 (polar p3 0 6))
(setq p6 (polar p3 (/ (- 0 pi) 4) 1))
(setvar "snapmode" 0)
(setvar "osmode" 0)
(command ".text" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tl" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
)
(progn
(setq p4 (polar p3 (* (/ pi 4) 3) 1))
(setq p5 (polar p3 pi 6))
(setq p6 (polar p3 (* (/ (- 0 pi) 4) 3) 1))
(setvar "snapmode" 0)
(setvar "osmode" 0)
(command ".text" "j" "r" p4 "" 0 (strcat (RTOS S2 2 2))
".text" "j" "tr" p6 "" "" (strcat (RTOS m1 2 2))
".pline" p2 "w" 0.1 0.1 p3 p5 "" )
)
)

(setvar "snapmode" 0)
(setvar "osmode" 16383)

(princ)
)

Hề hề hề,

Bạn thông cảm vì mình không hiểu hết ý của bạn. Mình sửa như vầy thì lisp sẽ chỉ chạy đúng nếu cái text cao độ bạn chọn là Text, còn không đảm bảo đúng khi text đó là Mtext bạn nhé...

Nếu có gì chưa đúng bạn lại post lên nhé.

Chúc bạn vui.

Thanks anh nhiều! Đúng ý em rồi! Giờ chỉ nhờ anh chỉnh lại 1 chút xíu nữa thôi đó là khi đặt text đổi vị trí 2 cái text đó lên trên xuống dưới ngược lại cụ thể là:

Cao độ thiết kế điểm nằm trên

Cao độ đáy cống nằm dưới!

Làm phiền anh thêm chút nữa!

Tháng 1 19, 2011

Thanks anh nhiều! Đúng ý em rồi! Giờ chỉ nhờ anh chỉnh lại 1 chút xíu nữa thôi đó là khi đặt text đổi vị trí 2 cái text đó lên trên xuống dưới ngược lại cụ thể là:
Cao độ thiết kế điểm nằm trên

Cao độ đáy cống nằm dưới!

Làm phiền anh thêm chút nữa!

Hề hề hề,

Chuyện này có nhẽ bạn làm được mà.

Chỉ cần bạn chú ý chút xíu và đổi lại chỗ này:

(command ".text" p4 "" 0 (strcat (RTOS S2 2 2))

".text" "j" "tl" p6 "" "" (strcat (RTOS m1 2 2))

".pline" p2 "w" 0.1 0.1 p3 p5 "" )

Thành:

(command ".text" p4 "" 0 (strcat (RTOS m1 2 2))

".text" "j" "tl" p6 "" "" (strcat (RTOS S2 2 2))

".pline" p2 "w" 0.1 0.1 p3 p5 "" )

Và bạn nhớ là phải đổi ở cả hai đoạn code như vầy có trong lisp. Nếu không sẽ có lúc nó lại "u như kỵ" đó.

Hề hề hề...

Tháng 1 19, 2011

Các bác ơi, em đã từng đọc ở diễn đàn mình và một số diễn đàn khác có nói về lisp đưa các trắc ngang vào viewport khung a3 nhưng down về mà làm mãi không dcj. MOng các bác giúp em với ạ. Hay bác nào có lisp đưa trắc ngang vào khung in bản vẽ a3 ti lệ 500 thì cho em xin. cám ơn các bác..hihi

hic hic. các bác ơi , giúp em với.... :)

Tháng 1 19, 2011

sr các bác.. đay là chương trình mà thấy mọi ng gọi là xếp tn..mong các bác giúp đỡ :http://www.cadviet.com/upfiles/3/new_folder_7.rar

Tháng 1 19, 2011

cảm ơn lời góp ý của bác...e sẽ để ý hơn...thanks bác!!! mà bác có thể xem giúp e cái lisp dim (d_dc_da_qd_dg.lsp) ở trên với được ko...e ko thể dùng được...đánh lệnh d hay da thì ko thấy có ji.?

Mình đã thử sử dụng đi thử lại lisp đó rồi, vẫn bình thường.Bạn đã lấy lại phần mình sửa lỗi chưa ??? Mình post lại bên dưới, bạn thử xem sao.Nếu vẫn "không thấy gì" thì không còn cách nào khác, lúc sử dụng lệnh gặp lỗi ở chỗ nào bạn hãy ấn F2 và chụp lại màn hình cho ketxu xem thì mới biết được ^^..Như mình vẫn nói, hok ai chữa bệnh ung thư qua điện thoại cả :)

;free líp from cadviet.com @ gia_bach
(defun c:d() (VeDim "d"))
(defun c:dc() (VeDim "dc"))
(defun c:da() (VeDim "da"))
(defun c:qd() (VeDim "qd"))
(defun c:dg() (Vedim "dg"))
(defun VeDim(input / ov vl)
(defun *error* (msg)
(if ov (mapcar 'setvar vl ov)); reset Sys Vars
(if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
(princ (strcat "\n** Error: " msg " **")))
(princ))

(setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(setvar "cmdecho" 0) 
(if (tblsearch "layer" "08-dim")
(setvar "clayer" "08-dim")
(command "-layer" "M" "08-dim" "" ) )
(setvar "cmdecho" 1)
(cond
((= input "d")(command "_dimlinear"))
((= input "da")(command "_dimaligned"))
((= input "dc")(command "_dimcontinue"))
((= input "dg")(command "_dimangular"))
((= input "qd")(command "qdim"))
)
(while (= (getvar "CMDACTIVE") 1) (command pause))
(mapcar 'setvar vl ov) ; reset Sys Vars
(princ)
)
;;;;;;;

Tháng 1 20, 2011

Mình đã thử sử dụng đi thử lại lisp đó rồi, vẫn bình thường.Bạn đã lấy lại phần mình sửa lỗi chưa ??? Mình post lại bên dưới, bạn thử xem sao.Nếu vẫn "không thấy gì" thì không còn cách nào khác, lúc sử dụng lệnh gặp lỗi ở chỗ nào bạn hãy ấn F2 và chụp lại màn hình cho ketxu xem thì mới biết được ^^..Như mình vẫn nói, hok ai chữa bệnh ung thư qua điện thoại cả :)
;free líp from cadviet.com @ gia_bach
(defun c:d() (VeDim "d"))
(defun c:dc() (VeDim "dc"))
(defun c:da() (VeDim "da"))
(defun c:qd() (VeDim "qd"))
(defun c:dg() (Vedim "dg"))
(defun VeDim(input / ov vl)
(defun *error* (msg)
(if ov (mapcar 'setvar vl ov)); reset Sys Vars
(if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
(princ (strcat "\n** Error: " msg " **")))
(princ))

(setq vl '("clayer" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(setvar "cmdecho" 0) 
(if (tblsearch "layer" "08-dim")
(setvar "clayer" "08-dim")
(command "-layer" "M" "08-dim" "" ) )
(setvar "cmdecho" 1)
(cond
((= input "d")(command "_dimlinear"))
((= input "da")(command "_dimaligned"))
((= input "dc")(command "_dimcontinue"))
((= input "dg")(command "_dimangular"))
((= input "qd")(command "qdim"))
)
(while (= (getvar "CMDACTIVE") 1) (command pause))
(mapcar 'setvar vl ov) ; reset Sys Vars
(princ)
)
;;;;;;;

thanks bác !!!cuối cùng thì e cũng dùng được rồi...

có 1 lisp ve hatch cũng tham khảo trên diễn đàn nhưng e gà về lisp wá mong bác sửa giup với...đoạn lisp này sau khi hatch xong thi nó không tự chuyển về layer 00-09hatch và không có chế độ associative..e cũng mò thử thêm dòng (setvar "hpassoc" 1) vaf (setvar "hpgaptol" 1000.0) để có thể hatch cả miền hở nhưng bó tay :)...nên phai nhờ cao thủ giúp thôi.

;===== AUTO HATCH (hh) ========

(defun mkhatch(v_hatchtp v_scale v_angle data_m / i)
(command "hatch" v_hatchtp v_scale v_angle)
(setvar "hpassoc" 1)
       (setq i 0)
(while (< i (length data_m)) (progn
	(command (nth i data_m))
	(setq i (+ i 1))
))
(command "")  
)

(defun c:hh(/ data_m check)


(defun ah_import(/ p1 p2 old1 ent1 ent2 axa)
 (if (= nil hscale_d) (setq hscale_d 1))  
 (setq old1 (getvar "osmode") check 1)
 (setvar "osmode" 0)
 (setq p1 '(0 0 0) p2 p1)
 (command "line"  p1 p2 "")

 (setq data_m '())
 (setq ent1 (entlast) ent2 ent1)

 (princ ent1)

 (setvar "osmode" old1)

 (command "boundary")
 (setq p1 (getpoint))
 (while (not (= nil p1)) (progn

(command p1)


(setq p1 (getpoint))

 ))
 (command "")

 (setq ent1 (entnext ent1))

 (princ ent1)
 (if (= nil ent1) (setq check 0) (progn
(while (not (= nil ent1)) (progn
	(setq data_m (append data_m (list ent1)))
	(setq ent1 (entnext ent1))
))
 ))
 (command "erase" ent2 "")
 (princ)
)

(defun ah_procced(/ i s1)

 (if (= 0 check) (princ "\ninvalid data") (progn
(initget 1 "0 WALL W GRASS GR GROUND G MARBLE M WC S SAND B BRICK")
 	(setq s1 (getkword "\n0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK : "))
(if (not (= nil s1)) (progn
	(cond
	  ((= "0" (strcase s1)) (mkhatch "dots" (* 1500 hscale_d) 0 data_m))
	  ((= "WC" (strcase s1)) (mkhatch "ansi37" (* 2000 hscale_d) 45 data_m))
	  ((or (= "GR" (strcase s1)) (= "GRASS" (strcase s1))) (progn
			(mkhatch "CROSS" (* 500 hscale_d) 0 data_m)

	  ))
	  ((or (= "S" (strcase s1)) (= "SAND" (strcase s1))) (progn
			(mkhatch "ar-sand" (* 30 hscale_d) 0 data_m)


	  ))

((or (= "G" (strcase s1)) (= "GROUND" (strcase s1))) (mkhatch "hound" (* 3000 hscale_d) 0 data_m))
((or (= "M" (strcase s1)) (= "MARBLE" (strcase s1))) (mkhatch "ar-conc" (* 30 hscale_d) 0 data_m))
((or (= "B" (strcase s1)) (= "BRICK" (strcase s1))) (mkhatch "ar-b816c" (* 25 hscale_d) 0 data_m))
((or (= "W" (strcase s1)) (= "WALL" (strcase s1))) (mkhatch "ANSI31" (* 300 hscale_d) 0 data_m))
	)
   ))						 

(command "erase")
(setq i 0)
(while (< i (length data_m)) (progn
	(command (nth i data_m))
	(setq i (+ i 1))
))
(command "")

 ))

 (princ)
)
 (ai_undo_push)	
 (ah_import)

 (ah_procced)
 (ai_undo_pop)
)

...!!!hok có bác nào giúp e sửa líp này với nhỉ..:)

Tháng 1 21, 2011

Có thể viết dùm mình cái lisp bao chọn một vùng để sử dụng lệnh (Lengthen -> De -> nhập khoảng cách kéo dài) không,chứ select từng cái 1 thì lâu quá.Mình muốn chọn luôn toàn bộ bản vẽ.

Thanks

Tháng 1 21, 2011

Có thể viết dùm mình cái lisp bao chọn một vùng để sử dụng lệnh (Lengthen -> De -> nhập khoảng cách kéo dài) không,chứ select từng cái 1 thì lâu quá.Mình muốn chọn luôn toàn bộ bản vẽ.
Thanks

Lisp thì viết đuợc nhưng ...

làm thế nào đế phân biệt phía cần kéo dài (điểm đầu hay điểm cuối)?

Tháng 1 21, 2011

Lisp thì viết đuợc nhưng ...
làm thế nào đế phân biệt phía cần kéo dài (điểm đầu hay điểm cuối)?

Mình muốn kéo dài cả 2 phía luôn.

Thanks

Tháng 1 21, 2011

Mình muốn kéo dài cả 2 phía luôn.
Thanks

đối tượng trên bản vẽ của bạn gồm những gì. Line, polyline hay arc hay tất cả mọi thứ...

Tháng 1 21, 2011

Có thể viết dùm mình cái lisp bao chọn một vùng để sử dụng lệnh (Lengthen -> De -> nhập khoảng cách kéo dài) không,chứ select từng cái 1 thì lâu quá.Mình muốn chọn luôn toàn bộ bản vẽ.
Thanks

Mình cũng không rõ mục đích của bạn làm gì, k biết thừa ra 1 tí thì bản vẽ KT nó có đẹp k ^^

;free lisp from cadviet.com @ ketxu
(defun c:keodai (/ ss kc)
 (vl-load-com)
  (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE,ARC")))
            kc (getdist "\nChieu dai phan dua ra: "))
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (command "_.lengthen"
                 "_delta"
                 kc
                 (list ent (vlax-curve-getendpoint ent))
                 (list ent (vlax-curve-getstartpoint ent))
                 ""
        ) ;kthuc command
      ) ; kthuc vong lap
 (princ)
)

P/S : với Pline kín thì k sử dụng lengthen để kéo dài được, bạn muốn làm với các cạnh của nó thì phải explode ra.

- Với Arc, nếu đoạn kéo dài lớn hơn phần cung hở, nó sẽ không kéo dài nữa (bỏ qua), nếu 2*đoạn kéo dài lớn hơn cung hở, nó sẽ chỉ kéo dài 1 đầu

Tháng 1 22, 2011

Mình cũng không rõ mục đích của bạn làm gì, k biết thừa ra 1 tí thì bản vẽ KT nó có đẹp k ^^
;free lisp from cadviet.com @ ketxu
(defun c:keodai (/ ss kc)
 (vl-load-com)
  (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE,ARC")))
            kc (getdist "\nChieu dai phan dua ra: "))
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (command "_.lengthen"
                 "_delta"
                 kc
                 (list ent (vlax-curve-getendpoint ent))
                 (list ent (vlax-curve-getstartpoint ent))
                 ""
        ) ;kthuc command
      ) ; kthuc vong lap
 (princ)
)
P/S : với Pline kín thì k sử dụng lengthen để kéo dài được, bạn muốn làm với các cạnh của nó thì phải explode ra.

- Với Arc, nếu đoạn kéo dài lớn hơn phần cung hở, nó sẽ không kéo dài nữa (bỏ qua), nếu 2*đoạn kéo dài lớn hơn cung hở, nó sẽ chỉ kéo dài 1 đầu

Thanks.Mình đã làm được rồi.

Mình thấy có vài bản vẽ kéo dài ra như vậy,và mình thích phong cách đó.thanks.

Ước gì mình cũng viết được lisp nhỉ.Chắc phải mày mò học thôi.:)

Tháng 1 22, 2011

các bạn cho mình hỏi có lisp nào nối các point trên bản vẽ theo số thứ tự mình đánh vào không. hoặc cao thủ nào giúp mình với. mình không biết up bản vẽ vì mới tham gia dd. lisp kiểu như làm bản đồ địa hình thì trên bản vẽ có point và cao độ, các chương trình chạy đường dồng mức là nối các điểm có cùng một cao độ. Nhưng ở đây mình muốn có lisp là trên bản vẽ có point, ứng với mỗi point có số thứ tự điểm 1, 2, 3..........n. muốn nối point theo số thứ tự mình nhập được không. kiểu như đánh một lệnh gì đó rồi đánh số thứ tự điểm cần nối với nhau thì trên bản vẽ sẽ nối point theo stt mình nhập bằng đường line ấy. mong các bạn giúp đỡ.

Tháng 1 22, 2011

các bạn cho mình hỏi có lisp nào nối các point trên bản vẽ theo số thứ tự mình đánh vào không. hoặc cao thủ nào giúp mình với. mình không biết up bản vẽ vì mới tham gia dd. lisp kiểu như làm bản đồ địa hình thì trên bản vẽ có point và cao độ, các chương trình chạy đường dồng mức là nối các điểm có cùng một cao độ. Nhưng ở đây mình muốn có lisp là trên bản vẽ có point, ứng với mỗi point có số thứ tự điểm 1, 2, 3..........n. muốn nối point theo số thứ tự mình nhập được không. kiểu như đánh một lệnh gì đó rồi đánh số thứ tự điểm cần nối với nhau thì trên bản vẽ sẽ nối point theo stt mình nhập bằng đường line ấy. mong các bạn giúp đỡ.

Để upload file bạn :

1.Upload trực tiếp lên host diễn đàn : vào trang Upload phía bên trên tay phải -> thực hiện thao tác như hướng dẫn, sau đó copy link file trả về. Mục post bài có nút Insert Link, bạn kich vô đó và Paste đường dẫn vừa lấy được ở trang upload vào

2. Upload lên host khác, như MF chẳng hạn, rồi copy link và lại chèn vào bài viết như trên

P/S : ý tưởng của bạn thì mình hiểu rồi, nhưng mình thì bó tay.Hok biết stt điểm của bạn thể hiện bằng cách nào đây ^^

Tháng 1 22, 2011

Để upload file bạn :
1.Upload trực tiếp lên host diễn đàn : vào trang Upload phía bên trên tay phải -> thực hiện thao tác như hướng dẫn, sau đó copy link file trả về. Mục post bài có nút Insert Link, bạn kich vô đó và Paste đường dẫn vừa lấy được ở trang upload vào

2. Upload lên host khác, như MF chẳng hạn, rồi copy link và lại chèn vào bài viết như trên

P/S : ý tưởng của bạn thì mình hiểu rồi, nhưng mình thì bó tay.Hok biết stt điểm của bạn thể hiện bằng cách nào đây ^^

rất cảm ơn bạn đã quan tâm. STT, POINT, đều liên quan đến nhau, tức là mình phun lên CAD từ máy toàn đạc điện tử trút ra có số thứ tự điểm, toạ độ x, toạ độ y, cao độ H(nếu có)

bạn xem bản vẽ có lẽ sẽ hiểu vấn đề ngay.

http://www.cadviet.com/upfiles/3/upload.dwg

Tháng 1 22, 2011

các bạn cho mình hỏi có lisp nào nối các point trên bản vẽ theo số thứ tự mình đánh vào không. hoặc cao thủ nào giúp mình với. mình không biết up bản vẽ vì mới tham gia dd. lisp kiểu như làm bản đồ địa hình thì trên bản vẽ có point và cao độ, các chương trình chạy đường dồng mức là nối các điểm có cùng một cao độ. Nhưng ở đây mình muốn có lisp là trên bản vẽ có point, ứng với mỗi point có số thứ tự điểm 1, 2, 3..........n. muốn nối point theo số thứ tự mình nhập được không. kiểu như đánh một lệnh gì đó rồi đánh số thứ tự điểm cần nối với nhau thì trên bản vẽ sẽ nối point theo stt mình nhập bằng đường line ấy. mong các bạn giúp đỡ.

Sorry bạn vì dù có ý tưởng tổng quát hơn nhưng mình không cụ thể hóa thành code được, đành giúp bạn trong trường họp cá biệt này ( point trùng với điểm đặt text, nên để kẻ line mình sẽ chỉ cần duyệt qua text để xử lý thôi), bạn thử xem sao.Lisp cho phép bạn kẻ 1 loạt line từ điểm bắt đầu đến kết thúc, bạn chọn vùng cần kẻ, nhập vào số nhỏ nhất đến lớn nhất và xem KQ

;free lisp from cadviet.com @ ketxu
(defun c:pt2p(/ ss i ent so sslst mint maxt)
(vl-load-com)
;Loc text
(setq ss (ssget '((0 . "TEXT") (8 . "CT_SO")))  sslst (ssadd) i 0) 
(setq mint (getint "\nKe line noi tu so : ")
      maxt (getint "\nDen so : "))
(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
 (setq so (atoi(cdr(assoc 1 (entget x)))))
	(if (and  
		 (>= so mint)
		 (			(setq sslst (ssadd x sslst))
	)
)
;Sap xep lai
(setq
sslst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sslst)))
sslst (vl-sort sslst
'(lambda (e1 e2)
((atoi (cdr (assoc 1 (entget e1))))
(atoi (cdr (assoc 1 (entget e2))))
)
)
))
;Ke line
(setvar "clayer" "LINE")
(setq i 0)
(while ((command ".line" (cdr(assoc 10 (entget (nth i sslst)))) (cdr (assoc 10 (entget (nth (1+ i) sslst)))) "")
(setq i (1+ i))
)
)

P/S : hình như file số liệu của bạn làm bằng phần mềm, phun thứ tự các điểm từ bé đến lớn, mình k bên chuyên ngành nên k biết, nên code trên thậm chí k cần sắp xếp lại list các phần tử được chọn (bỏ hẳn đoạn sắp xếp lại đi) thì nó vẫn kẻ đúng thứ tự, trừ khi bạn edit text ^^

Tháng 1 22, 2011

Sorry bạn vì dù có ý tưởng tổng quát hơn nhưng mình không cụ thể hóa thành code được, đành giúp bạn trong trường họp cá biệt này ( point trùng với điểm đặt text, nên để kẻ line mình sẽ chỉ cần duyệt qua text để xử lý thôi), bạn thử xem sao.Lisp cho phép bạn kẻ 1 loạt line từ điểm bắt đầu đến kết thúc, bạn chọn vùng cần kẻ, nhập vào số nhỏ nhất đến lớn nhất và xem KQ

P/S : hình như file số liệu của bạn làm bằng phần mềm, phun thứ tự các điểm từ bé đến lớn, mình k bên chuyên ngành nên k biết, nên code trên thậm chí k cần sắp xếp lại list các phần tử được chọn (bỏ hẳn đoạn sắp xếp lại đi) thì nó vẫn kẻ đúng thứ tự, trừ khi bạn edit text ^^

Rất cảm ơn bạn ketxu. Lisp của bạn viết rất hay, mình rất vui. Nhưng bạn viết theo ý tưởng của mình thì tốt quá. ví dụ như bạn chọn vùng cần vẽ rồi nhập từng số thứ tự vẽ có được không: kiểu như

nhập số thứ tự bắt đầu? 1

số thứ tự tiếp theo? 2

số thứ tự tiếp theo? 5

số thứ tự tiếp theo? xxx

tương ứng mỗi lần nhập như thế thi vẽ line theo số thứ tự nhập vào vậy đó.

vì đây là file vẽ bản đồ, muốn vẽ 1 địa vật như nhà, đưòng GT hay một địa vật nào đó. số thứ tự cần nối không phải là cứ 1 rồi 2 rồi ...n. vì khi đo có thể quên hoặc đo diểm khác trước rồi mới quay lại cho nên stt cần nối không phải là từ 1 đến 2 rồi đến 3 rồi n được. cảm ơn bạn nhiều.

Đăng nhập

Viết lisp theo yêu cầu [phần 2]

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

hungvq 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

ketxu 2.984

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

Tue_NV 3.912

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

ketxu 2.984

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

shitty 3

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

phamthanhbinh 3.146

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

truongthanh 7

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

phamthanhbinh 3.146

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

truongthanh 7

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

phamthanhbinh 3.146

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

ngocnam.cad 6

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

ngocnam.cad 6

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

ketxu 2.984

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

shitty 3

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

CaravenA 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

gia_bach 1.549

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

CaravenA 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

phamngoctukts 714

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

ketxu 2.984

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

CaravenA 0