Nhờ viết hộ lisp chia trần siêu tốc

[hoangtdh 8]

Gửi các anh chị trong diễn đàn.

Từ ngày em tham gia diễn đàn học được bao lisp hay giúp rút ngắn thời gian vẽ xuống rất nhiều. Tiện đây cho em gửi lời cảm ơn tới tất cả mọi người. Nhờ các anh chị viết hộ lisp chia trần giả với nội dung như file cad minh họa đính kèm:

- Khoảng cách các ô trần là 610x610

- Chia từ tâm phòng ra (2 cạnh bên đều nhau)

- 1 tấm trần ở các cạnh tường phải có kích thước 305x305 trở lên

 

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

Em Hoàng

[hoangtdh 8]

Các cao thủ đâu hết rồi mà không thấy trả lời. Để em viết cách làm thủ công để mọi người dễ lập trình.

- Bước 1: dùng lệnh hatch, trong mục type chọn user defined, angle =0, spacing=610, trong mục hatch origin chọn specified origin và center

- Bước 2: dùng hatch tương tự nhưng với angle=90

- Bước 3: đo các mép tường tới đường gần nhất nếu khoảng cách >=305 thì ok còn nếu không move hatch 1 khoảng 305 rồi dùng lệnh trim chặt phần dôi ra ngoài tường.

Mong các cao thủ ra tay giúp đỡ.

Hoàng

[Tue_NV 3.912]

Các cao thủ đâu hết rồi mà không thấy trả lời. Để em viết cách làm thủ công để mọi người dễ lập trình.

- Bước 1: dùng lệnh hatch, trong mục type chọn user defined, angle =0, spacing=610, trong mục hatch origin chọn specified origin và center

- Bước 2: dùng hatch tương tự nhưng với angle=90

- Bước 3: đo các mép tường tới đường gần nhất nếu khoảng cách >=305 thì ok còn nếu không move hatch 1 khoảng 305 rồi dùng lệnh trim chặt phần dôi ra ngoài tường.

Mong các cao thủ ra tay giúp đỡ.

Hoàng

Bài toán cũng khá đơn giản mà sao bạn làm các bước khá "lâu" vậy

Bạn thử code này nhé :

(defun c:df(/ e kcv p kcx kcy dvx dvy dv)
 (setq e (car(entsel)))
 (setq kcv (getreal "\n Khoang cach luoi o vuong :"))
 (setq p (ACET-ENT-GEOMEXTENTS e) d1 (car p) d2 (cadr p)
 	kcx (abs (- (car d1) (car d2)))
kcy (abs (- (cadr d1) (cadr d2)))
dvx (* (/ (- (/ kcx kcv) (fix (1- (/ kcx kcv)))) 2) kcv)
dvy (* (/ (- (/ kcy kcv) (fix (1- (/ kcy kcv)))) 2) kcv)
dv (mapcar '+ d1 (list dvx dvy 0.0))
 )
 (command "ucs" "m" dv)
 (command "hatch" "u" "0" kcv "y" e "")
 (command "ucs" "p" )
)

[ketxu 2.983]

Yêu cầu của bạn có thể đáp ứng được nhưng mình thấy sao bạn không dùng ansi37 để dễ thao tác, hoặc dùng Line (để dễ lập trình) nhỉ ^^

P/S bác Tuệ : đoạn quan trọng nhất trong yêu cầu còn thiếu bác ạ.nếu không thì chỉ cần hatch center là đã ra kquả như lisp r bác ^^

[Tue_NV 3.912]

.....

P/S bác Tuệ : đoạn quan trọng nhất trong yêu cầu còn thiếu bác ạ.nếu không thì chỉ cần hatch center là đã ra kquả như lisp r bác ^^

Nếu Hatch theo lời bạn viết thì không thõa mãn yêu cầu ở dưới.

Bạn thử kiểm tra lại xem

....

Tiện đây cho em gửi lời cảm ơn tới tất cả mọi người. Nhờ các anh chị viết hộ lisp chia trần giả với nội dung như file cad minh họa đính kèm:

- Khoảng cách các ô trần là 610x610

- Chia từ tâm phòng ra (2 cạnh bên đều nhau)

- 1 tấm trần ở các cạnh tường phải có kích thước 305x305 trở lên

.......

[hoangtdh 8]

Gửi bạn Tuệ,

Rất cám ơn bạn. Lisp của bạn chưa đáp ứng đưọc yêu cầu là các cạnh phải thoả mãn từ 305x305 trở lên để tránh cắt vụn tấm trần. Đây là phần khó nhất của lisp này.

Trong file cad lúc đầu của mình có minh họa cách chia trần đúng và sai để các bạn tham khảo. Minh post lại để bạn xem.

 

http://www.cadviet.c...ia_tran_gia.dwg

Hoàng

[ketxu 2.983]

(defun c:df(/ e kcv p kcx kcy dvx dvy dv)
 (setq e (car(entsel)))
 (setq kcv (getreal "\n Khoang cach luoi o vuong :"))
 (setq p (ACET-ENT-GEOMEXTENTS e) d1 (car p) d2 (cadr p)
 	kcx (abs (- (car d1) (car d2)))
kcy (abs (- (cadr d1) (cadr d2)))	
dvx (* (/ (- (/ kcx kcv) (fix (1- (/ kcx kcv)))) 2) kcv)
dvy (* (/ (- (/ kcy kcv) (fix (1- (/ kcy kcv)))) 2) kcv)
 )
(if (< dvx 305) (setq dvx (+ dvx 305)))  
(if (< dvy 305) (setq dvy (+ dvx 305)))
(setq dv (mapcar '+ d1 (list dvx dvy 0.0)))
 (command "ucs" "m" dv)
 (command "hatch" "u" "0" kcv "y" e "")
 (command "ucs" "p" )
)

Bạn sửa lại một chút lisp bác Tuệ viết cho bạn là như trên là được

[Tue_NV 3.912]

Gửi bạn Tuệ,

Rất cám ơn bạn. Lisp của bạn chưa đáp ứng đưọc yêu cầu là các cạnh phải thoả mãn từ 305x305 trở lên để tránh cắt vụn tấm trần. Đây là phần khó nhất của lisp này.

Trong file cad lúc đầu của mình có minh họa cách chia trần đúng và sai để các bạn tham khảo. Minh post lại để bạn xem.

 

http://www.cadviet.c...ia_tran_gia.dwg

Hoàng

Ơ, sao vậy nhỉ??

Lisp chạy ra đúng kết quả như vậy cơ mà???

(defun c:df(/ e kcv p kcx kcy dvx dvy dv)
 (setq e (car(entsel)))
 (setq kcv (getreal "\n Khoang cach luoi o vuong :"))
 (setq p (ACET-ENT-GEOMEXTENTS e) d1 (car p) d2 (cadr p)
 	kcx (abs (- (car d1) (car d2)))
kcy (abs (- (cadr d1) (cadr d2)))	
dvx (* (/ (- (/ kcx kcv) (fix (1- (/ kcx kcv)))) 2) kcv)
dvy (* (/ (- (/ kcy kcv) (fix (1- (/ kcy kcv)))) 2) kcv)
 )
(if (< dvx 305) (setq dvx (+ dvx 305)))  
(if (< dvy 305) (setq dvy (+ dvx 305)))
(setq dv (mapcar '+ d1 (list dvx dvy 0.0)))
 (command "ucs" "m" dv)
 (command "hatch" "u" "0" kcv "y" e "")
 (command "ucs" "p" )
)

Bạn sửa lại một chút lisp bác Tuệ viết cho bạn là như trên là được

Bạn sửa như vậy là không hợp lý rồi

dvx và dvy bao giờ cũng lớn hơn kcv/2 (tức là lớn hơn 305). Bạn đọc kỹ rồi kiểm tra lại nhé

Hơn nữa, Bạn sửa vô 305 như vậy thì khoảng cách lưới không bằng 610 thì sao????

Lisp của Tue_NV chạy tốt, không có vấn đề gì cả.

[hoangtdh 8]

Gửi bạn ketxu,

Vẫn không được bạn ah. Bạn chạy thử lisp trên chính file cad mà mình gửi. Nếu kết quả ra đúng như hình chia trần đúng là ok.

Bạn kiểm tra lại nhé.

Hoàng

[Tue_NV 3.912]

Gửi bạn ketxu,

Vẫn không được bạn ah. Bạn chạy thử lisp trên chính file cad mà mình gửi. Nếu kết quả ra đúng như hình chia trần đúng là ok.

Bạn kiểm tra lại nhé.

Hoàng

Kiểm tra rồi đây :

http://www.youtube.com/watch?v=MRxd6U2QJe8

[ketxu 2.983]

Ơ, sao vậy nhỉ??

Lisp chạy ra đúng kết quả như vậy cơ mà???

 

Bạn sửa như vậy là không hợp lý rồi

dvx và dvy bao giờ cũng nhỏ hơn kcv/2 (tức là nhỏ hơn 305). Bạn đọc kỹ rồi kiểm tra lại nhé

Hơn nữa, Bạn sửa vô 305 như vậy thì khoảng cách lưới không bằng 610 thì sao????

Lisp của Tue_NV chạy tốt, không có vấn đề gì cả.

Command: df

 

Select object:

Khoang cach luoi o vuong :610

ucs

Current ucs name: *WORLD*

Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis]

<World>: m

Specify new origin point or [Zdepth]<0,0,0>:

Command: hatch

Enter a pattern name or [?/Solid/User defined] <_USER>: u

Specify angle for crosshatch lines <0>: 0

Specify spacing between the lines <610.0000>: 610.0000000000000

Double hatch area? [Yes/No] <Y>: y Select objects to define hatch boundary or

<direct hatch>,

 

Select objects: 1 found

 

Select objects:

Command: ucs

Current ucs name: *NO NAME*

Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis]

<World>: p

Command: nil

 

Command: !dvx

381.693

 

@chủ topic : Không được là ở chỗ nào, bạn phải nói bọn tớ mới gỡ bí được chứ.Tớ test lisp của bác Tuệ cái đầu ra giống cái sai bạn chỉ, test lisp sủaw lại OK .Có lẽ nên rào chắn thêm vài biến sysvar double,origin lại cho chắc

[hoangtdh 8]

Gửi bạn Tuệ,

Mình ko down được df.lsp và xem được video nên mình nghĩ có sự nhầm lẫn nào đó. Vì vậy mình gửi bạn file chạy thử của mình và file df.lsp mình tạo ra từ code của bạn (được bạn ketxu chỉnh lại) để bạn test lại xem có sự khác biệt nào không:

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

 

http://www.cadviet.com/upfiles/3/df.lsp

Ghi chú: các tấm trần ở cạnh ko nhất thiết là 610x610 vì nó phụ thuộc vào khoảng cách chiều dài và rộng của phòng, tuy nhiên người ta yêu cầu phải lớn hơn 305x305 để tránh cắt vụn tấm trần và khó làm.

Hoàng

[ketxu 2.983]

E bị loạn rồi ^^ Bác Tuệ gửi phần mềm quay phim e với :")

Dvx và Dvy > 305 chứ ạ ^^

Vì yêu cầu của bạn ý chốt tấm sàn ngoài lớn hơn 305x305 nên e k để là kcv /2

 

P/S : 3 anh em mình test khác nhau có lẽ do vài thằng biến không hợp nhau

 

(defun c:df()
 (setq e (car(entsel)))
 (setq kcv (getreal "\n Khoang cach luoi o vuong :"))
 (setq p (ACET-ENT-GEOMEXTENTS e) d1 (car p) d2 (cadr p)
 	kcx (abs (- (car d1) (car d2)))
kcy (abs (- (cadr d1) (cadr d2)))	
dvx (* (/ (- (/ kcx kcv) (fix (1- (/ kcx kcv)))) 2) kcv)
dvy (* (/ (- (/ kcy kcv) (fix (1- (/ kcy kcv)))) 2) kcv)
 )
(setq dv (mapcar '+ d1 (list dvx dvy 0.0)))
(acet-sysvar-set (list "hpname" "_USER" "HPORIGINMODE" 0 "hpdouble" 1 "HPORIGIN" dv "hpspace" kcv))
(command "-hatch" dv "")
(acet-sysvar-restore)
)

Bạn test lại xem sao

[hoangtdh 8]

Gửi bạn ketxu,

Mình đã test. 1 chiều ra 382 (đúng), 1 chiều ra 255 (sai)-> đúng phải là 560.

Bạn kiểm tra lại nhé.

Hoàng

[ketxu 2.983]

Mình đã test đúng cả 2 chiều, chiểu kia ra chính xác 560.092 :") Không biết CAD bạn còn có gì ảnh hưởng nữa không ^^

Mà như thế thì nghe hơi lại nhỉ ^^ Vì x và y được set theo cùng 1 cách giống nhau, đúng thì đúng cả, mà sai thì sai hết chứ ^^ Lạ quá..

[Tue_NV 3.912]

E bị loạn rồi ^^ Bác Tuệ gửi phần mềm quay phim e với :")

Dvx và Dvy > 305 chứ ạ ^^

Vì yêu cầu của bạn ý chốt tấm sàn ngoài lớn hơn 305x305 nên e k để là kcv /2

 

P/S : 3 anh em mình test khác nhau có lẽ do vài thằng biến không hợp nhau

 

(defun c:df()
 (setq e (car(entsel)))
 (setq kcv (getreal "\n Khoang cach luoi o vuong :"))
 (setq p (ACET-ENT-GEOMEXTENTS e) d1 (car p) d2 (cadr p)
 	kcx (abs (- (car d1) (car d2)))
kcy (abs (- (cadr d1) (cadr d2)))	
dvx (* (/ (- (/ kcx kcv) (fix (1- (/ kcx kcv)))) 2) kcv)
dvy (* (/ (- (/ kcy kcv) (fix (1- (/ kcy kcv)))) 2) kcv)
 )
(setq dv (mapcar '+ d1 (list dvx dvy 0.0)))
(acet-sysvar-set (list "hpname" "_USER" "HPORIGINMODE" 0 "hpdouble" 1 "HPORIGIN" dv "hpspace" kcv))
(command "-hatch" dv "")
(acet-sysvar-restore)
)

Bạn test lại xem sao

Sorry! mình viết nhầm ấy mà.

Lisp của mình và ketxu chỉnh lại đều như nhau. Ra cùng 1 kết quả đúng

Có lẽ đây là 1 nhược điểm rất lớn của hàm Command vì nó chịu sự tác động của các biến hệ thống

[hoangtdh 8]

Gửi bạn ketxu,

Mình đã test lại, chuẩn ko cần chỉnh.(Có lẽ do mình chưa restart lại cad nên vẫn nhận lisp cũ, thành thật xin lỗi bạn). Bây giờ mình muốn bạn cải tiến lisp 1 chút theo hướng sau đây:

- Thực tế trên thị trường có 2 loại tấm trần là 610x610 và 1220x610 (hoặc 610x1220) , vì vậy mình muốn nhập được 2 thông số width (rộng) và length (dài) của tấm trần.

- Cách chia trần tương tự trên: đối với 610x610 thì khoảng cách tấm trần cạnh tường là >=305x305, đối với 1220x610 thì khoảng cách tấm trần cạnh tường là >=610x305 hoặc >=305x610 (đối với tấm trần 610x1220).

Cám ơn bạn rất nhiều.

Hoàng

[KHONGMINH 1]

LIPS không load xuong được các bạn ơi!Dự án của mình thì bên xây dựng họ vẽ chủ yếu dùng line để vẽ thôi không dùng Hatch.nhờ mấy Bác gửi Lips lại dùm e với.

[hoangtdh 8]

Gửi bạn Khổng Minh,

Bạn copy đoạn code vào notepad rồi save file thành df.lsp là được. Dùng hatch hay hơn line rất nhiều vì quản lý hatch dễ hơn quản lý line (khi cần line bạn chỉ cần explode là được).

Hoàng

[ketxu 2.983]

Gửi bạn ketxu,

Mình đã test lại, chuẩn ko cần chỉnh.(Có lẽ do mình chưa restart lại cad nên vẫn nhận lisp cũ, thành thật xin lỗi bạn). Bây giờ mình muốn bạn cải tiến lisp 1 chút theo hướng sau đây:

- Thực tế trên thị trường có 2 loại tấm trần là 610x610 và 1220x610 (hoặc 610x1220) , vì vậy mình muốn nhập được 2 thông số width (rộng) và length (dài) của tấm trần.

- Cách chia trần tương tự trên: đối với 610x610 thì khoảng cách tấm trần cạnh tường là >=305x305, đối với 1220x610 thì khoảng cách tấm trần cạnh tường là >=610x305 hoặc >=305x610 (đối với tấm trần 610x1220).

Cám ơn bạn rất nhiều.

Hoàng

Bạn test thử cái này xem.Mình chỉnh lại code 1 chút, bạn có thể chọn hàng loạt HCN bao, và lưu thông số length,width để đỡ phải nhập nhiều.Có kiểm tra kích thước ô trần so với tấm trần.Chúc bạn thành công.

 

;free lisp from cadviet.com @Tue_NV,ketxu
(defun c:df(/ p kcx kcy dvx dvy cc)
(if (not W) (setq W 610))
(if (not H) (setq H 610))
(setq W1 (getreal (strcat "\nChieu rong < " (rtos W 2 0) " >:")))
(setq H1 (getreal (strcat "\nChieu cao < " (rtos H 2 0) " >:")))
(if W1 (setq W W1))
(if H1 (setq H H1))
(acet-sysvar-set (list "hpname" "_USER" "HPORIGINMODE" 0 "hpdouble" 0 "cmdecho" 0))
(foreach e (acet-ss-to-list (ssget '((0 . "POLYLINE,LWPOLYLINE"))))  
 (setq p (acet-ent-geomextents e) d1 (car p) d2 (cadr p)
 	kcx (abs (- (car d1) (car d2)))
kcy (abs (- (cadr d1) (cadr d2)))	
dvx (* (/ (- (/ kcx W) (fix (1- (/ kcx W)))) 2) W)
dvy (* (/ (- (/ kcy H) (fix (1- (/ kcy H)))) 2) H)  
       cc (mapcar '+ d1 (list dvx dvy 0.0))	
)
(if (and (> kcx W) (> kcy H))
(progn 
(setvar "HPORIGIN" cc)
(setvar "hpang" 0)
(setvar "hpspace" H)
(command "-hatch" cc "")
(setvar "hpang" (/ pi 2))
(setvar "hpspace" W)
(command "-hatch" cc "")
)
(alert "\n Co o tran nho hon kich thuoc tam tran")
)
)
(acet-sysvar-restore)
)

 

Code chưa tối ưu,mình đặt việc chuyển biến hệ thống ngay trong vòng lặp, mà ngại đưa ra quá,n cũng không đáng lo mấy, vì cũng k thể có hàng nghìn ô trần đc, bạn dùng tạm ^^

[hoangtdh 8]

Gửi bạn ketxu,

Bạn kiểm tra lại code nhé, nó báo lỗi sau:

 

Command: ap

APPLOAD df.lsp successfully loaded.

Command: df

Unknown command "DF". Press F1 for help.

 

Ko hiểu sao dạo này ko down trực tiếp được lisp từ server mà toàn bị báo lỗi sau:

Not Found

The requested URL /cccc/sub/getfile.php was not found on this server.

Additionally, a 500 Internal Server Error error was encountered while trying to use an ErrorDocument to handle the request.

________________________________________

Apache/1.3.33 Server at www.cadviet.com Port 80

 

Bạn kiểm tra lại hộ mình nhé.

Hoàng

[ketxu 2.983]

Tất nhiên là mình kiểm tra rùi mới post lên chứ .hị hị. Bạn thử quote lại bài của mình để lấy code xem sao

[hoangtdh 8]

Gửi bạn Ketxu,

Bạn kiểm tra lại hộ mình nhé.

http://www.cadviet.com/upfiles/3/df_1.lsp

Cám ơn bạn nhiều

Hoàng

[ketxu 2.983]

Bạn đã làm như mình nói chưa :)

Còn file thì đây bạn

df

File bạn gửi lên thì dòng ;free lisp... ở ngay trước defun c:df, nên k có tác dụng.

Bạn làm theo đúng cách bạn nói đó, copy lại code rồi lưu ra lisp

[hoangtdh 8]

Gửi bạn ketxu,

Lisp của bạn quá tuyệt luôn, chuẩn không cần chỉnh. Thanks bạn rất nhiều.

Hoàng