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

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

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

File anh xuất ra dạng như vậy nè:

1,d 20.0000,-36.5000,-11.5000

2,d 20.0000,-15.0000,-5.0000

3,d 20.0000,-15.0000,5.0000

4,d 20.0000,15.0000,5.0000

5,d 20.0000,0.0000,-25.0000

 

Mà e cần xuất ra file txt có dạng là:

1,d 20,-36.5,-11.5

2,d 20,-15.0,-5.0

3,d 20,-15.0,5.0

4,d 20,15.0,5.0

5,d 20,0.0,-25.0

Nếu mà

1,d 20.0000,-36.5000,-11.5000

nó xuất thành : 1,d 20,-36.5,-11.5

thì quá tuyệt luôn, xuất nhanh như điện, hehe...

Mong anh giúp.

Sửa 1 chút chổ này xem:

(setq noidungdong (strcat (itoa (+ ttd 1)) ",d " (rtos drong 2 0) "," (rtos (car (nth ttd Rec)) 2 1) "," (rtos (cadr (nth ttd Rec)) 2 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
.....................................................

Nếu mà

1,d 20.0000,-36.5000,-11.5000

nó xuất thành : 1,d 20,-36.5,-11.5

thì quá tuyệt luôn, xuất nhanh như điện, hehe...

Mong anh giúp.

Sửa 1 chút chổ này xem:

(setq noidungdong (strcat (itoa (+ ttd 1)) ",d " (rtos drong 2 0) "," (rtos (car (nth ttd Rec)) 2 1) "," (rtos (cadr (nth ttd Rec)) 2 1)))

Tue_NV nghĩ Anh Duy nên thiết lập biến DIMZIN=8 khi chạy Code là hợp lý nhất.

(setvar "DIMZIN" 8)

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 nghĩ Anh Duy nên thiết lập biến DIMZIN=8 khi chạy Code là hợp lý nhất.

(setvar "DIMZIN" 8)

Dưng mà 5.0 thì bác này lại muốn giữ nguyên 1 số 0 sau dấu phẩy.

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
Dưng mà 5.0 thì bác này lại muốn giữ nguyên 1 số 0 sau dấu phẩy.

Dưng mà hoặc nếu mà thì anh có thể sử dụng hàm If :

- Lấy giá trị hiện tại của biến DimZin (để khi chạy xong trả lại cho user)

- Dưng mà (zerop (- so (fix so))) thì thiết lập (setvar "DIMZIN" 0)

- Dưng mà (not (zerop (- so (fix so)))) thì thiết lập (setvar "DIMZIN" 8)

+ Đoạn hàm con được xây dựng như sau :

(defun strs(so / sos)
(if (zerop (setq sos (- so (fix so))) )
(setvar "DIMZIN" 0)
(setvar "DIMZIN" 8)
)
so
)

Phần sửa lại như sau :

(setq noidungdong (strcat (itoa (+ ttd 1)) ",d "

(rtos (strs drong) 2 0) ","

(rtos (strs (car (nth ttd Rec))) 2 1) ","

(rtos (strs (cadr (nth ttd Rec))) 2 1)

))

Anh cứ thử xem nhá.

Chào anh. Chúc anh sức khoẻ

  • Vote tăng 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
Dưng mà hoặc nếu mà thì anh có thể sử dụng hàm If :

- Lấy giá trị hiện tại của biến DimZin (để khi chạy xong trả lại cho user)

- Dưng mà (zerop (- so (fix so))) thì thiết lập (setvar "DIMZIN" 0)

- Dưng mà (not (zerop (- so (fix so)))) thì thiết lập (setvar "DIMZIN" 8)

+ Đoạn hàm con được xây dựng như sau :

(defun strs(so / sos)
(if (zerop (setq sos (- so (fix so))) )
(setvar "DIMZIN" 0)
(setvar "DIMZIN" 8)
)
so
)

Phần sửa lại như sau :

(setq noidungdong (strcat (itoa (+ ttd 1)) ",d "

(rtos (strs drong) 2 0) ","

(rtos (strs (car (nth ttd Rec))) 2 1) ","

(rtos (strs (cadr (nth ttd Rec))) 2 1)

))

Anh cứ thử xem nhá.

Chào anh. Chúc anh sức khoẻ

Cái vụ ADIMZIN này hồi mình có tham gia nên có biết nhưng cứ chờ ý kiến của chủ chòm xem có ưng ý chưa hay lại chỉnh. Hồi chưa biết cái nhà anh DIMZIN này mình viết thèn thống kê thép hình có viết 1 đoạn để nhập độ dày phép như này tất nhiên chỉ tính tới trường hợp sau dấy phẩy là 2 số thôi. Bà con có ưng đồ cổ thì dom cho vui.

 

(Defun tinhdoday ( )

(setq w (getreal "\nDo day : "))

(setq wchan (fix w))

(setq wnhan (* w 100))

(setq wchannhan (* wchan 100))

(setq wdu (- wnhan wchannhan))

 

(setq ws (/ wdu 10))

(setq wchani (fix ws))

(setq wnhani (* ws 10))

(setq wchannhani (* wchani 10))

(setq wdui (- wnhani wchannhani))

 

(Cond

((= wdu 0)

(setq wm (rtos w 2 0))

)

((/= wdu 0)

(Cond

((= wdui 0)

(setq wm (rtos w 2 1))

)

((/= wdui 0)

(setq wm (rtos w 2 2))

)

)

)

)

(princ)

)

  • Vote tăng 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
Chào bác Phamngoctukts,

Mình đã test lisp của bác với bản vẽ do bạn W1ndream cung cấp thì thấy chưa được như ý bác ạ.

Sau khi đọc lại code của bác thì thấy cái nguyên tắc giãn text của bác khá đơn giản. Như vậy chỉ giãn được trong trường hợp hai text trùng nhau mà thôi, Nếu có một búi text trùng nhau thì khi giãn kiểu này lại sinh ra một sự trùng khác bác ạ.

Cám ơn bác về khúc code thay width factor vì mình chả nhớ cái mã nào nó thể hiện điều này nên chưa làm trong đoạn lisp của mình. Mình sẽ bổ sung ngay bác ạ.

Chúc bác khỏe và vui.

 

Bác à!Bác giúp em với

1.bổ sung cho em thêm fần Width text nha(chuyển tất cả các text về width=0.8 trừ nhóm text 1).

2.Thêm cho em đoạn mã mà sau khi đánh lệnh xong nó tự động select all và thực hiện các công việc em cần mà không cần select đối tượng thủ công nữa.

:lol:

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
Bác à!Bác giúp em với

1.bổ sung cho em thêm fần Width text nha(chuyển tất cả các text về width=0.8 trừ nhóm text 1).

2.Thêm cho em đoạn mã mà sau khi đánh lệnh xong nó tự động select all và thực hiện các công việc em cần mà không cần select đối tượng thủ công nữa.

:lol:

Bạn down lại code trên của Bác Bình đã sửa cho bạn rồi đấy. Muốn Select tất cả thì lúc select bạn đánh all vào là được.

  • Vote tăng 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
Bác à!Bác giúp em với

1.bổ sung cho em thêm fần Width text nha(chuyển tất cả các text về width=0.8 trừ nhóm text 1).

2.Thêm cho em đoạn mã mà sau khi đánh lệnh xong nó tự động select all và thực hiện các công việc em cần mà không cần select đối tượng thủ công nữa.

:lol:

Hề hề hề,

Cái thằng all này nó cũng tiện cho mấy anh lười, nhưng khổ lắm vớ phải cái bản vẽ mà chỉ cần sửa chút xíu trong khi bản vẽ thì cả đống đối tượng, khi đó bạn lại chửi cha cái thằng làm lisp thì cũng phiền hỉ. Chi bằng cứ liệu cơm mà gắp mắm chắc sẽ ngon miệng hơn bạn ạ. hề hề hề.

Muốn lười ti xíu thì bạn chỉ việc bổ sung đoạn code "x" vào sau thằng ssget là xong mừ. Hề hề hề. Cái vụ bị đòn mình vẫn kinh nên mong bạn cho mình hai chữ đại xá hỉ.......

Hề hề hề,.....

  • Vote tăng 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
Bạn down lại code trên của Bác Bình đã sửa cho bạn rồi đấy. Muốn Select tất cả thì lúc select bạn đánh all vào là được.

 

Ý em là tự động select all trong lisp bác à.

 

ps:à bác hoàn thiện Lisp lọc của bác cho em với được không?

Em đã gửi lên 1 đoạn code để giãn text nhanh hơn.Mong bác kết hợp xử lý hộ em với.Vì Lisp loc hiện tại đã xử lý được các vấn đề của em nhưng hơi chậm(4 mặt cắt /1 phút).

:lol:

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
Hề hề hề,

Cái thằng all này nó cũng tiện cho mấy anh lười, nhưng khổ lắm vớ phải cái bản vẽ mà chỉ cần sửa chút xíu trong khi bản vẽ thì cả đống đối tượng, khi đó bạn lại chửi cha cái thằng làm lisp thì cũng phiền hỉ. Chi bằng cứ liệu cơm mà gắp mắm chắc sẽ ngon miệng hơn bạn ạ. hề hề hề.

 

Nhưng với cái của em thì không việc jì khi select all bác à.

Muốn lười ti xíu thì bạn chỉ việc bổ sung đoạn code "x" vào sau thằng ssget là xong mừ. Hề hề hề. Cái vụ bị đòn mình vẫn kinh nên mong bạn cho mình hai chữ đại xá hỉ.......

Hề hề hề,.....

Em không biết jì về lisp mà bác bảo em thế thì khó em quá.bác sửa hộ em với nha.Có thể đính chính thêm sau lisp là chỉ dành cho mấy thằng lười. :lol: !

 

Nói đùa thế thôi chứ công việc em cần là 1 tổ hợp lisp để set các thành phần trong bản vẽ theo ý muốn nên buộc phải làm thế nếu không sẽ phải dùng từng lisp 1 riêng lẻ.

:lol:

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
Ý em là tự động select all trong lisp bác à.

 

ps:à bác hoàn thiện Lisp lọc của bác cho em với được không?

Em đã gửi lên 1 đoạn code để giãn text nhanh hơn.Mong bác kết hợp xử lý hộ em với.Vì Lisp loc hiện tại đã xử lý được các vấn đề của em nhưng hơi chậm(4 mặt cắt /1 phút).

:lol:

Chào w1nDream

Bạn muốn select all thì có thể làm theo cách này :

Khi chạy Lisp -> Ở dòng select object : bạn gõ All là được.

 

Select object : All

Bạn muốn chọn 1 nhóm đối tượng cũng được, hoặc chọn toàn bộ cũng được, hoặc là chọn rồi nhưng mà mình muốn bớt đi đối tượng cũng được luôn (Nhấn R ở dòng select object : hoặc nhấn Shift khi bớt đối tượng)

Đây là các tùy chọn ở dòng Select object :

Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P

revious/Undo/AUto/SIngle

 

@Anh Duy : Cái Lisp thống kê thép hình của anh bây giờ đúng là "đồ cổ" rồi :lol: . Hic, hic :lol: , bây giờ thì dùng cái Table của CAD hiệu quả hơn nhiều :cheers:

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
Ý em là tự động select all trong lisp bác à.

 

ps:à bác hoàn thiện Lisp lọc của bác cho em với được không?

Em đã gửi lên 1 đoạn code để giãn text nhanh hơn.Mong bác kết hợp xử lý hộ em với.Vì Lisp loc hiện tại đã xử lý được các vấn đề của em nhưng hơi chậm(4 mặt cắt /1 phút).

:lol:

Từ hôm trước tới giờ mình cứ tưởng bạn dùng lisp của Bác Bình ngon rồi nên không nghiên cứu tiếp. Có gì để mình viết nốt cho bạn.

  • Vote tăng 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
Chào w1nDream

Bạn muốn select all thì có thể làm theo cách này :

Khi chạy Lisp -> Ở dòng select object : bạn gõ All là được.

 

Select object : All

Bạn muốn chọn 1 nhóm đối tượng cũng được, hoặc chọn toàn bộ cũng được, hoặc là chọn rồi nhưng mà mình muốn bớt đi đối tượng cũng được luôn (Nhấn R ở dòng select object : hoặc nhấn Shift khi bớt đối tượng)

Đây là các tùy chọn ở dòng Select object :

Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/P

revious/Undo/AUto/SIngle

 

@Anh Duy : Cái Lisp thống kê thép hình của anh bây giờ đúng là "đồ cổ" rồi :lol: . Hic, hic :lol: , bây giờ thì dùng cái Table của CAD hiệu quả hơn nhiều :lol:

 

1/- Bác Tue_NV ơi,

Ý bạn w1ndream là hổng muốc lóc cóc lách cách chi cả, uỵch phát ăn ngay cơ. Vậy nên chơi quả "x" là có nhẽ hợp ý bạn ấy nhất. Ngặt một nỗi là bạn ấy lại chả biết cái "x" này nên thôi thì bác nhón tay làm phúc chỉ cho bạn ấy cách dùng hàm ssget luôn thể bác nhé. Mình thì văn cục chữ hòn nên chưa biết chỉ sao cho bạn ấy đụng đậy một tí cái tư duy về lisp cả. Viết thêm một tí đâu có khó nhọc chi, nhưng bạn ấy cũng cần biết cái thêm ấy để làm gì thì mới sướng bác ạ. Hề hề hề..... Tự sướng mãi cũng buồn bác nhỉ????

 

2/- Hề hề hề,

Đồ cổ bây giờ có giá lắm bác ơi.

Cũ thì cũ vậy nhưng xơi vẫn .... an toàn bác ạ.....

Cái anh table này hay thì hay vậy nhưng chơi nó vẫn phải canh chừng đó bác.......

Hề hề hề.....

 

Chúc bác khỏe và vui.

 

@ w1ndream: Bạn đem ông Tu cắm vô cằm mình nhột quá nhột quá..... Cái củ lisp giãn tetxt bạn biếu vẫn chửa gặm xong nên đành hề hề hề xin lỗi bạn vậy.......

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
1/- Bác Tue_NV ơi,

Ý bạn w1ndream là hổng muốc lóc cóc lách cách chi cả, uỵch phát ăn ngay cơ. Vậy nên chơi quả "x" là có nhẽ hợp ý bạn ấy nhất. Ngặt một nỗi là bạn ấy lại chả biết cái "x" này nên thôi thì bác nhón tay làm phúc chỉ cho bạn ấy cách dùng hàm ssget luôn thể bác nhé. Mình thì văn cục chữ hòn nên chưa biết chỉ sao cho bạn ấy đụng đậy một tí cái tư duy về lisp cả. Viết thêm một tí đâu có khó nhọc chi, nhưng bạn ấy cũng cần biết cái thêm ấy để làm gì thì mới sướng bác ạ. Hề hề hề..... Tự sướng mãi cũng buồn bác nhỉ????

 

2/- Hề hề hề,

Đồ cổ bây giờ có giá lắm bác ơi.

Cũ thì cũ vậy nhưng xơi vẫn .... an toàn bác ạ.....

Cái anh table này hay thì hay vậy nhưng chơi nó vẫn phải canh chừng đó bác.......

Hề hề hề.....

 

Chúc bác khỏe và vui.

 

@ w1ndream: Bạn đem ông Tu cắm vô cằm mình nhột quá nhột quá..... Cái củ lisp giãn tetxt bạn biếu vẫn chửa gặm xong nên đành hề hề hề xin lỗi bạn vậy.......

 

1.Bác hiểu đúng ý em roài đó. nếu có ai đó chỉ cho em thì càng tốt.Chỉ sợ em dốt Lisp chỉ lâu các bác lại nản nên mới nhờ luôn cho đỡ mất công các bac thôi.

 

@phamthanhbinh: Bác cố mà gặm đi rồi em còn đưa nốt cái "bà nhũ" cho nữa là Ưng hoàng fúc.

:lol:

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
Sửa 1 chút chổ này xem:

(setq noidungdong (strcat (itoa (+ ttd 1)) ",d " (rtos drong 2 0) "," (rtos (car (nth ttd Rec)) 2 1) "," (rtos (cadr (nth ttd Rec)) 2 1)))

Quá chính xác luôn anh ah.

Cám ơn anh nhiều lắm.

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
Dưng mà hoặc nếu mà thì anh có thể sử dụng hàm If :

- Lấy giá trị hiện tại của biến DimZin (để khi chạy xong trả lại cho user)

- Dưng mà (zerop (- so (fix so))) thì thiết lập (setvar "DIMZIN" 0)

- Dưng mà (not (zerop (- so (fix so)))) thì thiết lập (setvar "DIMZIN" 8)

+ Đoạn hàm con được xây dựng như sau :

(defun strs(so / sos)
(if (zerop (setq sos (- so (fix so))) )
(setvar "DIMZIN" 0)
(setvar "DIMZIN" 8)
)
so
)

Phần sửa lại như sau :

(setq noidungdong (strcat (itoa (+ ttd 1)) ",d "

(rtos (strs drong) 2 0) ","

(rtos (strs (car (nth ttd Rec))) 2 1) ","

(rtos (strs (cadr (nth ttd Rec))) 2 1)

))

Anh cứ thử xem nhá.

Chào anh. Chúc anh sức khoẻ

Hic, cao siêu quá, e chẳng hiểu chi cả, hichic.

giá như mà không xuất theo chiều dày của pline mà cho phép người nhập thì hay biết mấy ha....( như cái code này: http://www.mediafire.com/?pq42e3y492v12in, chỉ tiếc là tọa độ xuất ra không đúng thôi).

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
Cái vụ ADIMZIN này hồi mình có tham gia nên có biết nhưng cứ chờ ý kiến của chủ chòm xem có ưng ý chưa hay lại chỉnh. Hồi chưa biết cái nhà anh DIMZIN này mình viết thèn thống kê thép hình có viết 1 đoạn để nhập độ dày phép như này tất nhiên chỉ tính tới trường hợp sau dấy phẩy là 2 số thôi. Bà con có ưng đồ cổ thì dom cho vui.

 

(Defun tinhdoday ( )

(setq w (getreal "\nDo day : "))

(setq wchan (fix w))

(setq wnhan (* w 100))

(setq wchannhan (* wchan 100))

(setq wdu (- wnhan wchannhan))

 

(setq ws (/ wdu 10))

(setq wchani (fix ws))

(setq wnhani (* ws 10))

(setq wchannhani (* wchani 10))

(setq wdui (- wnhani wchannhani))

 

(Cond

((= wdu 0)

(setq wm (rtos w 2 0))

)

((/= wdu 0)

(Cond

((= wdui 0)

(setq wm (rtos w 2 1))

)

((/= wdui 0)

(setq wm (rtos w 2 2))

)

)

)

)

(princ)

)

Hic, em không áp dụng được...vào cái e xuất tọa độ.

Cám ơn anh nhiều, đã quan tâm chủ đề của em.

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
Hic, em không áp dụng được...vào cái e xuất tọa độ.

Cám ơn anh nhiều, đã quan tâm chủ đề của em.

Hị hị làm reng mà đc cái này là hàm con mà. Bạn thích cái chiều dày nhập vào phải ko? chờ chút sửa cho chứ khó gì

 

 

Đây nì

(Defun C:xtdpl ( )

(command "undo" "be")

(Prompt "\nChon doi tuong pline")

(setq doituong1 (entsel))

(while

(null doituong1)

(Prompt "\nChon doi tuong pline")

(setq doituong1 (entsel))

)

(setq doituongt (car doituong1))

(setq doituong (entget doituongt))

(setq drong (getstring "\nNhap do rong:"))

(setq TENFILELUUKETQUA (getfiled "Chon file de luu ket qua .txt:" "" "txt" 1))

(setq FILEMODEVIET (open TENFILELUUKETQUA "a"))

(setq luubatdiem (getvar "osmode"))

(setvar "osmode" 0)

(setq sodinh (cdr (assoc 90 doituong)))

(setq Rec (acet-geom-vertex-list doituongt))

(setq ttd 0)

(while (< ttd sodinh)

(setq noidungdong (strcat (itoa (+ ttd 1)) ",d " drong "," (rtos (car (nth ttd Rec)) 2 1) "," (rtos (cadr (nth ttd Rec)) 2 1)))

 

(write-line noidungdong FILEMODEVIET)

(setq ttd (1+ ttd))

)

(setvar "osmode" luubatdiem)

(close FILEMODEVIET)

(command "undo" "end")

(Princ)

)

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
Ý em là tự động select all trong lisp bác à.

 

ps:à bác hoàn thiện Lisp lọc của bác cho em với được không?

Em đã gửi lên 1 đoạn code để giãn text nhanh hơn.Mong bác kết hợp xử lý hộ em với.Vì Lisp loc hiện tại đã xử lý được các vấn đề của em nhưng hơi chậm(4 mặt cắt /1 phút).

:lol:

Chào bạn w1ndream!

Mình đã viết xong code cho bạn đây. Việc select all của bạn theo mình là không nên dùng vì trong bản vẽ có nhiều text mà mình không muốn xử lý thì nó.

Với việc select all thì số lượng text sẽ rất lớn do vậy việc xử lý của lisp sẽ bị chậm. Nếu bạn muốn nhanh thì nên select khoảng 2 bản vẽ một lần. Nói thì nói vậy thôi mình vẫn nhét thằng "x" vào trong ssget cho bạn. Nếu bạn muốn select từng nhóm để xử lý thì bạn mở file loc.lsp bằng nodepat xoá "x" tại dòng

(setq ss (ssget "x" '((0 . "TEXT")))). Chúc bạn vui.

(defun c:loc ()
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget "x" '((0 . "text")))
k 0
doc (ssadd)
)
(while (< k (sslength ss))
(setq name (ssname ss k)
ent1 (entget name)
p1 (cdr (assoc 10 ent1))
goc (cdr (assoc 50 ent1))
nd (cdr (assoc 1 ent1))
)
(if (and (/= (cdr (assoc 41 ent1)) 0.5) (eq (cdr (assoc 51 ent1)) 0))
(setq ent1 (entmod (subst (cons 41 0.8) (assoc 41 ent1) ent1)))
)
(if (eq nd "-0.00")
(setq ent1 (entmod (subst (cons 1 "0.00") (assoc 1 ent1) ent1)))
)
(if (and (eq nd "0.00") (eq goc (/ pi 2)))
(command "erase" (ssname ss k) "")
)
(if (and (eq goc (/ pi 2)) (/= nd "0.00"))
(setq doc (ssadd (cdr (assoc -1 ent1)) doc))
)
(setq k (1+ k))
)
(giantext doc)
(setvar "osmode" oldos)
(command "undo" "e")
)

(defun giantext ( td /)
(setq b 1)
(while (= b 1)
(setq b 0)
(setq i 0)
(while (< i (sslength td))
(setq name1 (ssname td i)
ent1 (entget name1)
p1 (cdr (assoc 10 ent1))
goc (cdr (assoc 50 ent1))
j 0)
(while (and (< j (sslength td)) (/= j i))
(setq name2 (ssname td j)
ent2 (entget name2)
p2 (cdr (assoc 10 ent2))
di (distance p1 p2)
caochu (cdr (assoc 40 ent2))
)
(if (< di caochu)
(progn
(if (< (car p1) (car p2))
(progn
(setq tam (polar p1 0 (/ di 2))
pt1 (polar tam pi (/ caochu 1.9))
pt2 (polar tam 0 (/ caochu 1.9))
)
(vl-cmdf "move" name1 "" p1 pt1)
(vl-cmdf "move" name2 "" p2 pt2)
)
)
(if (> (car p1) (car p2))
(progn
(setq tam (polar p2 0 (/ di 2))
pt1 (polar tam 0 (/ caochu 1.9))
pt2 (polar tam pi (/ caochu 1.9))
)
(vl-cmdf "move" name1 "" p1 pt1)
(vl-cmdf "move" name2 "" p2 pt2)
)
)
(setq b 1)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
)
)

(defun xulytxt ( sstxt / sx k a pxt1 pxt2 hi dis)
(setq k 0)
(setq sx (ssadd))
(while (< k (sslength sstxt))
(setq pxt1 (cdr (assoc 10 (entget (ssname sstxt k)))))
(setq a 0)
(while (< a (sslength sstxt))
(setq pxt2 (cdr (assoc 10 (entget (ssname sstxt a)))))
(setq hi (cdr (assoc 40 (entget (ssname sstxt a)))))
(setq dis (distance pxt1 pxt2))
(if (and (< dis hi) (eq (cadr pxt1) (cadr pxt2)))
(setq sx (ssadd (ssname sstxt k) sx))
)
(setq a (1+ a))
)
(setq k (1+ k))
)
sx
)

  • Vote tăng 2

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
Chào bạn w1ndream!

Mình đã viết xong code cho bạn đây. Việc select all của bạn theo mình là không nên dùng vì trong bản vẽ có nhiều text mà mình không muốn xử lý thì nó.

Với việc select all thì số lượng text sẽ rất lớn do vậy việc xử lý của lisp sẽ bị chậm. Nếu bạn muốn nhanh thì nên select khoảng 2 bản vẽ một lần. Nói thì nói vậy thôi mình vẫn nhét thằng "x" vào trong ssget cho bạn. Nếu bạn muốn select từng nhóm để xử lý thì bạn mở file loc.lsp bằng nodepat xoá "x" tại dòng

(setq ss (ssget "x" '((0 . "TEXT")))). Chúc bạn vui.

(defun c:loc ()
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget "x" '((0 . "text")))
k 0
doc (ssadd)
)
(while (< k (sslength ss))
(setq name (ssname ss k)
ent1 (entget name)
p1 (cdr (assoc 10 ent1))
goc (cdr (assoc 50 ent1))
nd (cdr (assoc 1 ent1))
)
(if (and (/= (cdr (assoc 41 ent1)) 0.5) (eq (cdr (assoc 51 ent1)) 0))
(setq ent1 (entmod (subst (cons 41 0.8) (assoc 41 ent1) ent1)))
)
(if (eq nd "-0.00")
(setq ent1 (entmod (subst (cons 1 "0.00") (assoc 1 ent1) ent1)))
)
(if (and (eq nd "0.00") (eq goc (/ pi 2)))
(command "erase" (ssname ss k) "")
)
(if (and (eq goc (/ pi 2)) (/= nd "0.00"))
(setq doc (ssadd (cdr (assoc -1 ent1)) doc))
)
(setq k (1+ k))
)
(giantext doc)
(setvar "osmode" oldos)
(command "undo" "e")
)

(defun giantext ( td /)
(setq b 1)
(while (= b 1)
(setq b 0)
(setq i 0)
(while (< i (sslength td))
(setq name1 (ssname td i)
ent1 (entget name1)
p1 (cdr (assoc 10 ent1))
goc (cdr (assoc 50 ent1))
j 0)
(while (and (< j (sslength td)) (/= j i))
(setq name2 (ssname td j)
ent2 (entget name2)
p2 (cdr (assoc 10 ent2))
di (distance p1 p2)
caochu (cdr (assoc 40 ent2))
)
(if (< di caochu)
(progn
(if (< (car p1) (car p2))
(progn
(setq tam (polar p1 0 (/ di 2))
pt1 (polar tam pi (/ caochu 1.9))
pt2 (polar tam 0 (/ caochu 1.9))
)
(vl-cmdf "move" name1 "" p1 pt1)
(vl-cmdf "move" name2 "" p2 pt2)
)
)
(if (> (car p1) (car p2))
(progn
(setq tam (polar p2 0 (/ di 2))
pt1 (polar tam 0 (/ caochu 1.9))
pt2 (polar tam pi (/ caochu 1.9))
)
(vl-cmdf "move" name1 "" p1 pt1)
(vl-cmdf "move" name2 "" p2 pt2)
)
)
(setq b 1)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
)
)

(defun xulytxt ( sstxt / sx k a pxt1 pxt2 hi dis)
(setq k 0)
(setq sx (ssadd))
(while (< k (sslength sstxt))
(setq pxt1 (cdr (assoc 10 (entget (ssname sstxt k)))))
(setq a 0)
(while (< a (sslength sstxt))
(setq pxt2 (cdr (assoc 10 (entget (ssname sstxt a)))))
(setq hi (cdr (assoc 40 (entget (ssname sstxt a)))))
(setq dis (distance pxt1 pxt2))
(if (and (< dis hi) (eq (cadr pxt1) (cadr pxt2)))
(setq sx (ssadd (ssname sstxt k) sx))
)
(setq a (1+ a))
)
(setq k (1+ k))
)
sx
)

 

1.Em làm được rồi nhưng quả thật là rất chậm.Có cách nào để làm nó nhanh hơn được không bác(vẫn select all). :lol:

 

2.Bác có thể giúp em đoạn Code chỉnh width text tất cả thành 0.8 được không.Có thể là Code riêng hoặc ghép cho em vào lisp Artxt.lsp của bác Bình cũng được.

 

:lol:

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
1.Em làm được rồi nhưng quả thật là rất chậm.Có cách nào để làm nó nhanh hơn được không bác(vẫn select all). :lol:

 

2.Bác có thể giúp em đoạn Code chỉnh width text tất cả thành 0.8 được không.Có thể là Code riêng hoặc ghép cho em vào lisp Artxt.lsp của bác Bình cũng được.

 

:lol:

Mình làm cái chỉnh tất cả width_factor về 0.8 đc thôi. nhưng chỉ là TEXT thôi nhé. Mtext thì mình chưa làm.

 

(defun c:8 (/ ssd i el en)
(setq ssd (ssget '((0 . "TEXT")))
  i 0); loc text
(while (< i (sslength ssd))
(setq en (ssname ssd i))
(setq el (vlax-ename->vla-object en))
	 (vlax-put-property el 'ScaleFactor 0.8)
(setq i (1+ i))
))

  • Vote tăng 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

chào các bạn! mình đang làm khảo sát và đo vẽ địa hình,nhờ các bạn viết giúp mình lisp chèn hàng loạt các block khác nhau trên mọt bản vẽ.(ví dụ điểm số 001(stt) là cây cổ thụ,002 cây dừa,006 chùa,......) những block mỗi lần muốn chèn vào phải vào menu insert >>>>block>>>>rồi mới lấy ra để chèn.điều này sẽ rất lâu.khi đã lấy ra một block còn phải tìm điểm để chèn nữa .nhờ các bạn viết giúp mình nhé.có thể là ở dòng comand gõ lệnh...........>>>>>stt "001"(là một điêm mia ngoài thực địa có cả toạ độ và cao độ)>>>tên block muốn chèn "cây cổ thụ">>>ENTER......

mình sẽ up lên một file mẫu http://www.mediafire.com/?ny6flp5ylk4aqzx

thanks all. mong các bạn giúp nhé

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
Các bác ơi!Giúp em luôn quả này với.(Nếu với riêng bác Bình thì đây là quả "bà Nhũ" đấy). :lol:

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

 

:lol:

của bạn đây

(defun c:ctxt ()
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget "x" (list (cons 0 "TEXT") (cons 8 "ENTDAUCO")))
k 0
)
(while (< k (sslength ss))
(setq name (ssname ss k)
ent (entget name)
)
(entmod (subst (cons 40 0.5) (assoc 40 ent) ent))
(command "change" name "" "p" "c" "1" "")
(setq k (1+ k))
)
(getvar "osmode" oldos)
(command "undo" "be")
)

  • Vote tăng 2

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
1.Em làm được rồi nhưng quả thật là rất chậm.Có cách nào để làm nó nhanh hơn được không bác(vẫn select all). :lol:

 

2.Bác có thể giúp em đoạn Code chỉnh width text tất cả thành 0.8 được không.Có thể là Code riêng hoặc ghép cho em vào lisp Artxt.lsp của bác Bình cũng được.

 

:lol:

Việc ghép vào lisp artxt là không cần thiết bởi mình đã ghép rồi bạn ạ.

Còn để riêng thì nó đây nè:

(defun c:chwf ()
(setq sst (ssget (list (cons 0 "text") ))
       n (sslength sst)
       i 0
)
(while (       (setq ent (ssname sst i)
              elst (entget ent)
      )
      (setq elst (entmod (subst (cons 41 0.8) (assoc 41 elst) elst)))
      (setq i (1+ i))
)
)

 

Hề hề hề, cái "bà nhũ" ấy của mình bác Phamngoctukts xơi mất rồi còn đâu????

 

@ Bác Pha5mngoctukts: có thể sử dụng mã DXF 62 để đổi màu cho nó cùng gu bác ạ........

  • Vote tăng 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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×