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

[dovanlinh 4]

Không biết điểm gốc của đối tượng dtext theo ý bạn là điểm nào trong 2 điểm sau:

- điểm bắt đầu của đối tượng Dtext, nó nằm ở góc dưới bên trái mỗi đối tượng dtext. Điểm này có mã DXF là 10

- điểm Justify của đối tượng Dtext, nó nằm ở một trong các vị trí: Left, center, right, top left, top center ... của text. Điểm này có mã DXF là 11.

 

Mình lấy ví dụ cho trường hợp 1 nhé. trường hợp 2 cũng tương tự.

@vqhnb: Lisp bạn cần mình nhớ ở diễn đàn đã có. bạn PHẢI TÌM KIẾM TRƯỚC khi post yêu cầu nhé (dùng hộp thoại tìm kiếm). nếu vì một lý do nào đó lisp đã có trên diễn đàn chưa phù hợp với nhu cầu của bạn thì hãy post yêu cầu đê mọi người sửa giúp bạn.

chuẩn rổi! cám ơn nhé!

[thiep 365]

cám ơn bạn nhiều, nhưng mình muốn nối điểm tự do,ko muốn nối tư động,nếu có thế thực hiện trên 1 lớp thì tốt hơn..mong bạn giúp đở... :s_big:

Chào kamezoko, nếu muốn nối điểm tự do thì nối bằng tay thôi. Trong bản vẽ của bạn, các điểm 1, 2, 3 nối theo quy luật số tự nhiên tăng đều liên tục. Đến điểm 3 nối 5 nối 7 nối 9 nối 11 nối 13, dừng, thì không theo quy luật trên nữa mà tăng cách quảng 1. Các điểm: A1 nối A2 nối A3 nối A4 thì dừng, không nối tiếp? Còn nối điểm theo lớp, thì cũng có quy luật nối, nếu không lisp sẽ không hiểu hoặc nối tùm lum.

Đến đây Thiep bó tay.com!

Thiep nghĩ lisp JD.lsp mà Thiep chỉnh sửa cũng rất có ích cho những nhà địa chất công trình đó, trên 1 mặt cắt địa chất công trình có nhiiều hố khoan đã phân tầng theo quy luật: Hố khoan HK1 được phân tầng bởi các điểm A1, B1 ... Z1. Hố khoan HK2 được phân tầng bởi các điểm A2, B2 ... Z2. Hố khoan HKn (n là số tự nhiên) được phân tầng bởi các điểm An, Bn ... Zn. Dùng lisp JD sẽ khoanh nối được các ranh giới các tầng địa chất.

[phamthanhbinh 3.146]

Cám ơn bạn 'phamthanhbinh'

mình muốn một phát ăn ngay xơi hết tất cả các điểm không chơi bắn tỉa. Thực ra mình chỉ biết tác dụng của chương trình lisp thôi chứ chưa một ngày học lisp. Ý mình là dùng một lisp để chuyển ra kết quả cuối cùng nhưng ở dòng Command: lisp có hỏi là có đổi cao độ hay không tức là +,-,*,/ vào một số x nào đấy vì có lúc công trình chỉ dùng cao độ giả định, nhưng có công trình lại đỏi hỏi cao độ quốc gia. thanks lời chúc của bạn

Chào bạn vqhnb,

Xin lỗi bạn vì mình khong phải dân giao thông hay trắc địa như bạn nên chưa hiểu được ý bạn ngay. Mình cũng đã đọc các bài pót của bác TueNV bác Thaistreet về cách giải quyết các vấn đề của bạn. Không biết bạn có còn cần nữa không, nhưng theo cái cách hiểu củ chuối của mình thì mình cũng viết thử một cái lisp hy vọng sẽ giúp được bạn.

Cách giải quyết của mình thật ra không được hay và trọn vẹn như các bác ấy đã nêu nhưng có lẽ theo mình thì nó trực diện hơn và có vẻ dễ hiểu hơn cho những người mới học lisp.

Trước hết về phần chọn đối tượng mình sử dụng hàm ssget để bạn có thể dễ dàng lựa chọn đúng đối tượng cần chuyển đối. Bởi vì trên bản vẽ của bạn hẳn còn nhiều loại text khác nhau chứ không phải chỉ có các text số như vậy.

Sau khi bạn lựa chọn xong các đối tượng cần chuyển, có thể dùng cửa sổ để lựa chọn hay pick từng con trên bản vẽ cũng được. Nhấn enter lisp sẽ chuyển các đối tượng này về kiểu số chứa hai chữ số thập phân.

Sau khi chuyển các text này về đúng giá trị chứa hai chữ số thấp phân, lisp sẽ hỏi ban có muông thay đổi cao độ hay không, nếu bạn trả lời y (yes) thì lisp sẽ hỏi bạn phép tính mà bạn cần sử dụng, (cộng hay trừ hay nhân hay chia) bạn sẽ nhâp tên phép tính này vào theo đúng các ký tự đã gợi ý trong ngoặc và enter. Khi đó lisp sẽ hỏi bạn giá trị mà bạn cần nhập vào phép tính đó. Khi bạn đã nhập xong giá trị và enter thì lisp sẽ tự tính toán và trả ra kết quả bạn mong muốn đối với tất cả các đối tượng mà bạn đã thực hiện phép lựa chọn ở bên trên.

Bạn hãy dùng thử và cho mình biết ý kiến của bạn nhé.

Lisp đây bạn ạ:

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

Lệnh chạy lisp vẫn là chgtxt như cái lisp trước của mình.

Sau khi bạn chạy thử, bạn có thể mở hai cái lisp mà mình gửi bạn ra để so sánh và tìm thấy những gì mình đã bổ sung thêm vào cái lisp cũ và bạn sẽ thấy nó không quá phức tạp đâu, chỉ đơn giản là sử dụng thêm các hàm điều kiện if, while và các hàm getxxx để nhập số liệu thôi bạn ạ.

Chúc bạn thành công trong công việc và cuộc sống.

 

Đây là lisp mình đã chỉnh sửa lại theo gợi ý của bác TueNV và cái lisp mẫu của bác Thaistreet. Nó đơn giản và ngắn hơn cái lisp trên nhiều. Rất hay nhưng bạn cần hiểu rõ cách dùng như bác Thaistreet đã chỉ ở bài trước.

Trong lisp này gộp các phép tính lại nên việc nhập số liệu cho các phép tính cần chú y kẻo nhầm sẽ cho kết quả sai.

Bạn xài thử xem nhé.

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

[Tue_NV 3.912]

Chào kamezoko, nếu muốn nối điểm tự do thì nối bằng tay thôi. Trong bản vẽ của bạn, các điểm 1, 2, 3 nối theo quy luật số tự nhiên tăng đều liên tục. Đến điểm 3 nối 5 nối 7 nối 9 nối 11 nối 13, dừng, thì không theo quy luật trên nữa mà tăng cách quảng 1. Các điểm: A1 nối A2 nối A3 nối A4 thì dừng, không nối tiếp? Còn nối điểm theo lớp, thì cũng có quy luật nối, nếu không lisp sẽ không hiểu hoặc nối tùm lum.

Đến đây Thiep bó tay.com!

Chào kamezoko và thiep

Lisp sau Tue_NV đã viết theo ý kamezoko nhưng chưa hoàn thành.

và mình post lên để giúp cho kamezoko.

Lisp trên nối điiẻm chèn Text lại với nhau theo ý của kamezoko.

Vì Lisp trên chưa hoàn hảo nên muốn thoát bạn bấm Esc 2 lần để thoát lệnh nhé.

Bạn xài tạm vậy :

(defun c:ntdt(/ lis a ss i ent chu p x)
(setvar "cmdecho" 0)
(prompt "Chon Text :")
(setq ss (ssget '((0 . "TEXT"))) i 0 lis nil res " " lisch "")
(while ((setq ent (entget(ssname ss i)))
(setq chu (cdr(assoc 1 ent)))
(setq p (cdr(assoc 10 ent)))
(setq lis (append lis (list (cons chu p))))
(setq lisch (strcat lisch chu res))
(setq i (1+ i))
)

(command "line")
(foreach x lis
(initget 1 (eval lisch))
(command 
(if (setq a (assoc (getkword "\n Nhap chu : ") lis)) 
(progn
(cdr a)
)
)
)
)

(princ)
)

Nếu thiep và mọi người rảnh thì xin sửa dùm Code này lại với vì hiện giờ Tue_NV rất bận. Thanks

[thiep 365]

Chào kamezoko và thiep

Lisp sau Tue_NV đã viết theo ý kamezoko nhưng chưa hoàn thành.

và mình post lên để giúp cho kamezoko.

Lisp trên nối điiẻm chèn Text lại với nhau theo ý của kamezoko.

Vì Lisp trên chưa hoàn hảo nên muốn thoát bạn bấm Esc 2 lần để thoát lệnh nhé.

Bạn xài tạm vậy :

(defun c:ntdt(/ lis a ss i ent chu p x)
....
(princ)
)

Nếu thiep và mọi người rảnh thì xin sửa dùm Code này lại với vì hiện giờ Tue_NV rất bận. Thanks

Chào Tue_NV, lisp trên yêu cầu người dùng đưa vào tên điểm bằng bàn phím để nối line. Thay vì vậy, người dùng ra lệnh LINE xong pick bằng chuột từng điểm một trên màn hình. Hai cách này giống nhau, thậm chí cách pick bằng chuột sẽ nhanh hơn.

Mặt khác, tọa độ điểm và tọa độ TEXT (tên điểm) đôi khi khác nhau đó bạn.

[phamthanhbinh 3.146]

Đây là lisp em đã viết lại theo gợi ý của anh Tuệ

Lisp sẽ đưa ra yêu cầu

- nhập số muốn nhân. (nếu không có thì enter bỏ qua)

- nhập số muốn chia. (nếu không có thì enter bỏ qua. em tách số muốn nhân và số muốn chia thành 2 số độc lập để đỡ fải nhẩm giá trị nghịch đảo của một số nào đó khi thực muốn hiện phép chia)

- nhập số muốn cộng (nếu không có thì enter bỏ qua. nếu muốn thực hiện phép trừ thay cho phép cộng thì chỉ cần nhập giá trị âm)

- chọn các text số cần thay đổi giá trị. --> OK

(defun c:tinh()
(setq i 0 nhan 1 chia 1 cong 0)
(setq 	nhan1 (getreal "\nnhap so muon nhan: ")
chia1 (getreal "\nnhap so muon chia: ")
cong1 (getreal "\nnhap so muon cong them: "))
(if nhan1 (setq nhan nhan1))
(if chia1 (setq chia chia1))
(if cong1 (setq cong cong1))
(prompt "\nchon cac so can sua ...")
(setq txt (ssget '((0 . "TEXT"))))
	(repeat (sslength txt)
	(setq txt_name (ssname txt i))
	  (setq txt_ent (entget txt_name))
	(setq cont1 (cdr(assoc 1 txt_ent)))
	(setq cont (atof cont1))
	(if (and (/= cont1 "0") (/= cont1 "0.0") (/= cont1 "0.00") (/= cont1 "0.000") (/= cont1 "0.0000") (/= cont1 "0.0000")  (/= cont1 "00.0") (/= cont1 "00.00") (/= cont1 "00.000") (/= cont1 "00.0000") (/= cont1 "00.0000") (= cont 0)) ()
	(progn
	(setq s (+ (/ (* cont nhan) chia) cong))
	(setq txt_ent  (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))
	(entmod txt_ent)))
	(setq i (+ i 1))
);repeat
);defun

Quả thật sau khi hoàn thiện lisp này mới thấy ý tưởng của anh Tuệ rất hay, rất thông minh. cảm ơn anh đã góp ý để em hoàn thiện code này. :s_big:

 

Đoạn code này em có bổ xung thêm phần lọc đối tượng text là số và chuỗi ký tự. cách làm hơi củ chuối tý nhưng em nghĩ nó hoạt động tương đối hiệu quả rồi. hiện tại em cũng chưa nghĩ ra cách nào tốt hơn giúp lọc đối tượng text thành số và chuỗi ký tự riêng biệt.

cách làm này có nhược điểm:

- bị giới hạn nhận diện các số có giá trị bằng 0 (ngoài các số có giá trị là 0 đã đưa vào lisp như trên thì các số 0 dạng khác nó sẽ hiểu thành chuỗi ký tự. VD số 0.0 thì nó nhận diện được, còn số 000.00000 nó hiểu là chuỗi ký tự "000.00000" và ko thực hiện phép tính cho số này)

- còn bị nhầm lẫn một chỗi ký tự thành một số nếu các kỹ tự đầu chuỗi là số. VD chỗi 23ABCD thì nó sẽ hiểu thành 23.

tuy nhiên những trường hợp trên là rất ít gặp và có thể khắc phục trong qúa trình sử dụng. Hi vọng anh Tuệ mọi người có cách khác hay hơn.

Vấn đề tách các loại chuỗi bằng lisp quả thật là vấn đề nan giải, cho nên theo mình nghĩ để có thể sử dụng tốt lisp này nên đưa tất cả các text số cần chuyển đổi về một lớp tạm thời nào đó, sau đó dùng hàm ssget với tham số x và bộ lọc mang tên lớp này.

Sau khi thực hiện xong các bước chuyển đổi sẽ trả các đối tượng về lớp cũ của nó và xóa lớp tạm thời đi.

Cách này có bất lợi là nếu như các text số nằm trên quá nhiều lớp thì việc lưu giữ tên các lớp này sẽ khá rắc rối.

Đó là cái ngu ý của mình, mong các bác góp thêm ý kiến nha.

[Tue_NV 3.912]

Vấn đề tách các loại chuỗi bằng lisp quả thật là vấn đề nan giải, cho nên theo mình nghĩ để có thể sử dụng tốt lisp này nên đưa tất cả các text số cần chuyển đổi về một lớp tạm thời nào đó, sau đó dùng hàm ssget với tham số x và bộ lọc mang tên lớp này.

Sau khi thực hiện xong các bước chuyển đổi sẽ trả các đối tượng về lớp cũ của nó và xóa lớp tạm thời đi.

Cách này có bất lợi là nếu như các text số nằm trên quá nhiều lớp thì việc lưu giữ tên các lớp này sẽ khá rắc rối.

Đó là cái ngu ý của mình, mong các bác góp thêm ý kiến nha.

Chào bạn PhamThanhBinh và bạn Thaistreet

Bạn có thể xem thêm vấn đề này tại đây :

Viết Lisp theo yêu cầu - Bài viết số 2741

 

Bài viết của anh gia bách :

Chọn Text là số

 

và bài viết này nữa :

Phân biệt Text

 

@Thaistreet : Tue_NV đã viết bài trả lời bạn ở trang trước. Hy vọng bạn xây dựng Code thành công :s_big:

 

@ thiep : Rất cảm ơn bạn đã Reply. Mình hoàn toàn đồng ý với bạn.

[Tuynh 1]

Chào bạn Tuynh

Quả thật là mình không biết lệnh "tạo nhà" trong nova là lệnh nào. Phải chăng bạn muốn nói đến các loại địa vật vẽ trên trắc ngang? nếu không fải thì bạn cho mình tên lệnh và tên bản nova bạn đang dùng để mình kiểm tra nhé. nếu giúp được mình sẵn lòng.

Mình đưa hai file lên đây bạn xem thì hiểu ngay thôi.

http://www.cadviet.com/upfiles/2/tao_nha_1.rar

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

[Thaistreetz 539]

Chào bạn PhamThanhBinh và bạn Thaistreet

Bạn có thể xem thêm vấn đề này tại đây :

Viết Lisp theo yêu cầu - Bài viết số 2741

Bài viết của anh gia bách :

Chọn Text là số

và bài viết này nữa :

Phân biệt Text

 

@Thaistreet : Tue_NV đã viết bài trả lời bạn ở trang trước. Hy vọng bạn xây dựng Code thành công :cheers:

Đúng rồi. chỉ cân nhập số muốn chia dưới dạng 1/X là ok, vậy mà em không nghĩ ra.

cảm ơn anh đã thông tin cho em về hàm distof. có nó thì vấn đề lọc text theo số và chuỗi ký tự đã đc giải quyết một cách đơn giản.

code em đã sửa lại đây ạ. Em nghĩ thế này là nó đã hoàn thiện. :s_big:

(defun c:tinh()
(setq i 0 nhan 1 chia 1 cong 0)
(setq 	nhan1 (getreal (strcat "\n nhap so muon nhan hoac chia <" (rtos nhan 2 3) ">: "))
cong1 (getreal (strcat "\n nhap so muon cong hoac tru <" (rtos cong 2 3) ">:")))
(if nhan1 (setq nhan nhan1))
(if cong1 (setq cong cong1))
(prompt "\nchon cac so can sua ...")
(setq txt (ssget '((0 . "TEXT"))))
(command "undo" "begin")
(repeat 	(sslength txt)
(setq txt_name (ssname txt i))
(setq txt_ent (entget txt_name))
(setq cont1 (cdr(assoc 1 txt_ent)))
(setq cont (atof cont1))
(if (distof cont1 2)
	(progn
	(setq s (+ (* cont nhan) cong))
	(setq txt_ent  (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))
	(entmod txt_ent));if
);if
(setq i (+ i 1))
);repeat
(command "undo" "end")
);defun

@ bác Thanh Bình: hic, bác ơi, bác đừng gọi em là "bác Thaistreetz" nhé, tổn thọ em mất. Em mới ra trường chưa lâu và so với các bác ở đây chắc cũng chỉ được coi là "tụi trẻ" thôi bác ạ. :s_big:

[Thaistreetz 539]

Mình đưa hai file lên đây bạn xem thì hiểu ngay thôi.

http://www.cadviet.com/upfiles/2/tao_nha_1.rar

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

Mình ít phải vẽ bình đồ vì hầu hết các công trình mình làm đều có thể xin được bình đồ bên địa chính nên đúng là mình chưa sử dung lệnh này bao giờ cả.

Để vẽ cái này trên cad bằng lisp thì cũng khá đơn giản, mình có thể làm đc (tất nhiên sẽ không cần quá nhiều nhiều tùy chọn và ko có chế độ preview như Hài Hòa đã làm vì trình độ của mình chưa đủ để làm việc đó).

Mình sẽ đơn giản hóa nó thế này.

- Lisp sẽ vẽ 2 loại nhà (có lựa chọn cho bạn khi bắt đâu vẽ mỗi ngôi nhà): nhà mái ngói (giống yêu cầu của bạn) và nhà tầng với số tầng bạn nhập vào

- Text ghi số tầng của nhà tầng sẽ luôn nằm ngang (góc xoay của text là 0) theo trục tọa độ của bạn trong bản vẽ, chiều cao text bạn phải nhập vào ngay lúc bắt đầu chạy lệnh.

Ok chứ?

[Tuynh 1]

- Lisp sẽ vẽ 2 loại nhà (có lựa chọn cho bạn khi bắt đâu vẽ mỗi ngôi nhà): nhà mái ngói (giống yêu cầu của bạn) và nhà tầng với số tầng bạn nhập vào

- Text ghi số tầng của nhà tầng sẽ luôn nằm ngang (góc xoay của text là 0) theo trục tọa độ của bạn trong bản vẽ, chiều cao text bạn phải nhập vào ngay lúc bắt đầu chạy lệnh.

Ok chứ?

Ok bạn viết đi mình đang chờ bạn.

[Thaistreetz 539]

Đây là lisp vẽ nhà dùng để vẽ bình đồ theo cách vẽ của lệnh NHA trong NOVA nhưng đã được đơn giản hóa.

- khi vẽ chỉ cân pick vào 3 điểm góc của nhà.

- Lisp vẽ được 2 loại nhà: nhà ngói (hay nhà lá) và nhà tầng với số tầng nhập vào khi vẽ.

- Với nhà ngói, các đường thể hiện mái ngói được vẽ riêng bằng một layer khác.

- toàn bộ nhà được vẽ bằng layer NHATOANDAC

(Defun c:nha ( ) 
(if (not h) (setq h 1))
(setq h1 (getreal (strcat "\nCao text <"(rtos h 2 2)">:")))
(if h1 (setq h h1))
(setq laylast (getvar "clayer"))
(setq oslast (getvar "osmode"))
(setq colast (getvar "cecolor"))
(command "osmode" 109)
(setq pta (getpoint (strcat "\n pick diem thu nhat")))
(setq i1 0 i2 0)

(while (/= pta nil)
(command "undo" "begin")
(command "color" 1 "circle" pta 1)
(setq ss1 (ssget "L") ss (ssadd) ss (ssadd (ssname ss1 0) ss))
(setvar "cecolor" colast)
(setq ptb (getpoint (strcat "\n pick diem thu 2") pta))
(command "color" 2 "circle" ptb 1)
(setq ss2 (ssget "L") ss (ssadd (ssname ss2 0) ss))
(setvar "cecolor" colast)
(setq ptc (getpoint (strcat "\n pick diem thu 3") ptb))
(command "color" 3 "circle" ptc 1)
(setq ss3 (ssget "L") ss (ssadd (ssname ss3 0) ss))
(setvar "cecolor" colast)
(setq L1 (distance pta ptb) L2 (distance ptb ptc))
(setq ptd (polar pta (angle ptb ptc) L2))
(if (> L2 L1)
(setq pt1 pta pt2 ptb pt3 ptc)
(setq pt1 ptd pt2 pta pt3 ptb))
(setq L1 (distance pt1 pt2) L2 (distance pt2 pt3))
(setq goc1 (angle pt1 pt2))
(setq goc2 (angle pt2 pt3))
(setq pt4 (polar pt1 goc2 L2))
(setq pt5 (polar pt1 (- goc1 (/ pi 6)) (/ L1 2 (cos (/ pi 6)))))
(setq pt6 (polar pt3 (+ goc2 (/ pi 3)) (/ L1 -2 (cos (/ pi 6)))))
(setq pt7 (polar pt5 goc2 (/ (distance pt5 pt6) 2)))

(setq nha (cond (nha) ("Ngoi")))
(initget "Ngoi Tang")
(setq	Tmp1 (strcat "\nNha mai ngoi hay nha tang [Ngoi/Tang] <" nha ">: ")
nha (cond ((getkword Tmp1)) (nha)))
(if (not (tblsearch "layer" "NHATOANDAC"))
(command "-layer" "N" "NHATOANDAC" "S" "NHATOANDAC" "color" 7 "" "")
(command "Clayer" "NHATOANDAC"))

(if (eq Nha "Ngoi")
(progn
(Command "color" bylayer "osmode" 0 "pline" pt1 pt2 pt3 pt4 pt1 "")
(if (not (tblsearch "layer" "layer1"))
(command "-layer" "N" "layer1" "S" "layer1" "color" 8 "" "")
(command "Clayer" "layer1"));if
(command "pline" pt1 pt5 pt2 "")
(command "pline" pt5 pt6 "")
(command "pline" pt3 pt6 pt4 "")
(command "osmode" 109)
(setq i1 (1+ i1))
(setvar "cecolor" colast)
(command "erase" ss "")
(command "undo" "end")
);progn
(progn
(setq tang (cond (tang) ("2tang")))
(initget "2tang 3tang 4tang 5tang 6tang")
(setq	Tmp1 (strcat "\nNha bao nhieu tang [2Tang/3Tang/4Tang/5Tang/6Tang]<" tang ">: ")
tang (cond ((getkword Tmp1)) (tang)))
(Command "color" bylayer "osmode" 0 "pline" pt1 pt2 pt3 pt4 pt1"")
(if (eq tang "2tang") (command "color" 3 "text" "m" pt7 h 0 "2T"))
(if (eq tang "3tang") (command "color" 3 "text" "m" pt7 h 0 "3T"))
(if (eq tang "4tang") (command "color" 3 "text" "m" pt7 h 0 "4T"))
(if (eq tang "5tang") (command "color" 3 "text" "m" pt7 h 0 "5T"))
(if (eq tang "6tang") (command "color" 3 "text" "m" pt7 h 0 "6T"))
(setq i2 (1+ i2))
(command "osmode" 109)
(setvar "cecolor" colast)
(command "erase" ss "")
(command "undo" "end")
);progn
);if
(setq pta (getpoint (strcat "\n pick diem thu nhat")))
);while
(setvar "cecolor" colast)
(setvar "osmode" oslast)
(setvar "clayer" laylast)
(command "undo" "end")
(prompt (strcat "\nDa ve " (rtos i1 2 0) " nha ngoi va " (rtos i2 2 0) " nha tang\n"))
(prompt "\nby Thaistreetz - huuthais@yahoo.com\n")
);end.

Chú ý: Khi pick các điểm góc nhà ngói bạn bắt buộc phải pick lần lượt 3 góc theo chiều quay kim đồng hồ. Mình phát hiện lỗi này sau khi đã viết xong lisp nên ngại viết lại. bạn sử dụng chú ý một chút là ok thôi.

[Tuynh 1]

Đây là lisp vẽ nhà dùng để vẽ bình đồ theo cách vẽ của lệnh NHA trong NOVA nhưng đã được đơn giản hóa.

- khi vẽ chỉ cân pick vào 3 điểm góc của nhà.

- Lisp vẽ được 2 loại nhà: nhà ngói (hay nhà lá) và nhà tầng với số tầng nhập vào khi vẽ.

- Với nhà ngói, các đường thể hiện mái ngói được vẽ riêng bằng một layer khác.

- toàn bộ nhà được vẽ bằng layer NHATOANDAC

(Defun c:nha ( ) 
(if (not h) (setq h 1))
(setq h1 (getreal (strcat "\nCao text <"(rtos h 2 2)">:")))
(if h1 (setq h h1))
(setq laylast (getvar "clayer"))
(setq oslast (getvar "osmode"))
(setq colast (getvar "cecolor"))
(command "osmode" 109)
(setq pta (getpoint (strcat "\n pick diem thu nhat")))
(setq i1 0 i2 0)

(while (/= pta nil)
(command "undo" "begin")
(command "color" 1 "circle" pta 1)
(setq ss1 (ssget "L") ss (ssadd) ss (ssadd (ssname ss1 0) ss))
(setvar "cecolor" colast)
(setq ptb (getpoint (strcat "\n pick diem thu 2") pta))
(command "color" 2 "circle" ptb 1)
(setq ss2 (ssget "L") ss (ssadd (ssname ss2 0) ss))
(setvar "cecolor" colast)
(setq ptc (getpoint (strcat "\n pick diem thu 3") ptb))
(command "color" 3 "circle" ptc 1)
(setq ss3 (ssget "L") ss (ssadd (ssname ss3 0) ss))
(setvar "cecolor" colast)
(setq L1 (distance pta ptb) L2 (distance ptb ptc))
(setq ptd (polar pta (angle ptb ptc) L2))
(if (> L2 L1)
(setq pt1 pta pt2 ptb pt3 ptc)
(setq pt1 ptd pt2 pta pt3 ptb))
(setq L1 (distance pt1 pt2) L2 (distance pt2 pt3))
(setq goc1 (angle pt1 pt2))
(setq goc2 (angle pt2 pt3))
(setq pt4 (polar pt1 goc2 L2))
(setq pt5 (polar pt1 (- goc1 (/ pi 6)) (/ L1 2 (cos (/ pi 6)))))
(setq pt6 (polar pt3 (+ goc2 (/ pi 3)) (/ L1 -2 (cos (/ pi 6)))))
(setq pt7 (polar pt5 goc2 (/ (distance pt5 pt6) 2)))

(setq nha (cond (nha) ("Ngoi")))
(initget "Ngoi Tang")
(setq	Tmp1 (strcat "\nNha mai ngoi hay nha tang [Ngoi/Tang] <" nha ">: ")
nha (cond ((getkword Tmp1)) (nha)))
(if (not (tblsearch "layer" "NHATOANDAC"))
(command "-layer" "N" "NHATOANDAC" "S" "NHATOANDAC" "color" 7 "" "")
(command "Clayer" "NHATOANDAC"))

(if (eq Nha "Ngoi")
(progn
(Command "color" bylayer "osmode" 0 "pline" pt1 pt2 pt3 pt4 pt1 "")
(if (not (tblsearch "layer" "layer1"))
(command "-layer" "N" "layer1" "S" "layer1" "color" 8 "" "")
(command "Clayer" "layer1"));if
(command "pline" pt1 pt5 pt2 "")
(command "pline" pt5 pt6 "")
(command "pline" pt3 pt6 pt4 "")
(command "osmode" 109)
(setq i1 (1+ i1))
(setvar "cecolor" colast)
(command "erase" ss "")
(command "undo" "end")
);progn
(progn
(setq tang (cond (tang) ("2tang")))
(initget "2tang 3tang 4tang 5tang 6tang")
(setq	Tmp1 (strcat "\nNha bao nhieu tang [2Tang/3Tang/4Tang/5Tang/6Tang]<" tang ">: ")
tang (cond ((getkword Tmp1)) (tang)))
(Command "color" bylayer "osmode" 0 "pline" pt1 pt2 pt3 pt4 pt1"")
(if (eq tang "2tang") (command "color" 3 "text" "m" pt7 h 0 "2T"))
(if (eq tang "3tang") (command "color" 3 "text" "m" pt7 h 0 "3T"))
(if (eq tang "4tang") (command "color" 3 "text" "m" pt7 h 0 "4T"))
(if (eq tang "5tang") (command "color" 3 "text" "m" pt7 h 0 "5T"))
(if (eq tang "6tang") (command "color" 3 "text" "m" pt7 h 0 "6T"))
(setq i2 (1+ i2))
(command "osmode" 109)
(setvar "cecolor" colast)
(command "erase" ss "")
(command "undo" "end")
);progn
);if
(setq pta (getpoint (strcat "\n pick diem thu nhat")))
);while
(setvar "cecolor" colast)
(setvar "osmode" oslast)
(setvar "clayer" laylast)
(command "undo" "end")
(prompt (strcat "\nDa ve " (rtos i1 2 0) " nha ngoi va " (rtos i2 2 0) " nha tang\n"))
(prompt "\nby Thaistreetz - huuthais@yahoo.com\n")
);end.

Chú ý: Khi pick các điểm góc nhà ngói bạn bắt buộc phải pick lần lượt 3 góc theo chiều quay kim đồng hồ. Mình phát hiện lỗi này sau khi đã viết xong lisp nên ngại viết lại. bạn sử dụng chú ý một chút là ok thôi.

Cảm ơn bạn lisp chạy rất hay, mình nhờ bạn chút nữa được không, mình muốn góc nói như nào nhỉ, để mình gửi file lên nhé, giúp tớ một chút nữa nhé. Mình cũng thử chỉnh lại lisp nhưng mãi không được. Cám ơn bạn trước nhé.

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

[Thaistreetz 539]

Cảm ơn bạn lisp chạy rất hay, mình nhờ bạn chút nữa được không, mình muốn góc nói như nào nhỉ, để mình gửi file lên nhé, giúp tớ một chút nữa nhé. Mình cũng thử chỉnh lại lisp nhưng mãi không được. Cám ơn bạn trước nhé.

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

File bản vẽ trước bạn up lên cho mình xem là 30 đô. chính xác là 29 độ chứ không fải 25 độ

 

Góc 25 độ = pi/7.2 rad

bạn sửa 2 dòng này:

(setq pt5 (polar pt1 (- goc1 (/ pi 6)) (/ L1 2 (cos (/ pi 6)))))

(setq pt6 (polar pt3 (+ goc2 (/ pi 3)) (/ L1 -2 (cos (/ pi 6)))))

thành:

(setq pt5 (polar pt1 (- goc1 (/ pi 7.2)) (/ L1 2 (cos (/ pi 7.2)))))

(setq pt6 (polar pt3 (+ goc2 (/ pi 2.769)) (/ L1 -2 (cos (/ pi 7.2)))))

Chúc bạn thành công.

[Tuynh 1]

File bản vẽ trước bạn up lên cho mình xem là 30 đô. chính xác là 29 độ chứ không fải 25 độ

 

Góc 25 độ = pi/7.2 rad

bạn sửa 2 dòng này:

(setq pt5 (polar pt1 (- goc1 (/ pi 6)) (/ L1 2 (cos (/ pi 6)))))

(setq pt6 (polar pt3 (+ goc2 (/ pi 3)) (/ L1 -2 (cos (/ pi 6)))))

thành:

(setq pt5 (polar pt1 (- goc1 (/ pi 7.2)) (/ L1 2 (cos (/ pi 7.2)))))

(setq pt6 (polar pt3 (+ goc2 (/ pi 2.769)) (/ L1 -2 (cos (/ pi 7.2)))))

Chúc bạn thành công.

Uh bản vẽ trước là phần mềm tự tạo, mình thấy không đẹp lắm lên mới thay đổi như thế thôi, giờ thì tớ hiểu rồi cậu giải thích như này thì tớ có thể cho một góc theo ý muốn rồi. cám ơn bạn.

Chúc Thaistreetz sức khỏe, thành công trong cuộc sống nhé.

[kamezoko 3]

cám ơn TUE,Thiep nhiều lắm.. :cheers:

tại bản vẻ của tôi thì diểm chèn nằm dưới góc trái của text... :s_big:

chúc các bạn nhiều sức khỏe va thành công.. :s_big:

[dovanlinh 4]

Giúp em với, sao em tạo cái vòng lặp mà không được nhỉ?

(defun c:x1 ( / tx1 tx2 p1 p2 p3)
(setq p1 (getpoint "\nBase point"))
(setq p2 (getpoint "\nBase second point"))
(prompt "\nSelect base text:")
(setq tx1 (ssget))
  (while (setq tx2 (entsel "\nSelect next text:"))
     (setq P3 (cdr(assoc 10 (entget(car tx2))))) 
     (command "matchprop" tx1 tx2 "")
     (command "copy" tx2 "" p3 p2 "") 
     (setq p2 (polar p2 -90 400))
  )
)

[nataca 554]

Giúp em với, sao em tạo cái vòng lặp mà không được nhỉ?

(defun c:x1 ( / tx1 tx2 p1 p2 p3)
(setq p1 (getpoint "\nBase point"))
(setq p2 (getpoint "\nBase second point"))
(prompt "\nSelect base text:")
(setq tx1 (ssget))
  (while (setq tx2 (entsel "\nSelect next text:"))
     (setq P3 (cdr(assoc 10 (entget(car tx2))))) 
     (command "matchprop" tx1 tx2 "")
     (command "copy" tx2 "" p3 p2 "") 
     (setq p2 (polar p2 -90 400))
  )
)

Chưa hiểu mục đích viết lisp này của bạn là để làm việc gì?

[khaosat2009 11]

Nhờ bạn giúp cho việc chình các điểm vẽ nhà tạo thành các góc vuông.

và khi vẽ nhà có nhiều cạnh như chữ L

[dovanlinh 4]

Chưa hiểu mục đích viết lisp này của bạn là để làm việc gì?

mình muốn tạo lisp để khi mình chọn một đối tượng text thì nó tự động copy text đó, sau đó chuyển nó vể dạng của text cơ bản và sắp xếp thành một bảng. nhìn chung mục đính chính là tạo ra một bảng thống kê bản vẽ bằng việc chọn tên của các bản vẽ.

Cho mình hỏi thêm, viết lisp thế nảo để chuyển justin của text từ cẻnter về left nhỉ?

[Thaistreetz 539]

Giúp em với, sao em tạo cái vòng lặp mà không được nhỉ?

Chắc bạn ấy đang viết dở anh nataca ạ :s_big:

Điều kiện lặp của bạn là tx2 khác nil. như code của bạn thì nó thoát khỏi vòng lặp ngay sau lần lặp đầu tiên là đúng rồi.

bạn thêm dòng (setq tx2 (entsel "\nSelect next text:")) ngay trước khi đóng while là được.

[nataca 554]

mình muốn tạo lisp để khi mình chọn một đối tượng text thì nó tự động copy text đó, sau đó chuyển nó vể dạng của text cơ bản và sắp xếp thành một bảng. nhìn chung mục đính chính là tạo ra một bảng thống kê bản vẽ bằng việc chọn tên của các bản vẽ.

Cho mình hỏi thêm, viết lisp thế nảo để chuyển justin của text từ cẻnter về left nhỉ?

- Đoạn Lisp của bạn không sai về thuật toán. Có chăng là sai về góc trong hàm Polar (góc này phải là radian. Như vậy bạn phải thay -90 bằng -pi/2)

- Justify của Text được quy định bởi mã DXF 72 và 73. 72 là canh lề theo phương ngang, 73 là canh lề theo phương đứng. Nếu bạn muốn chuyển từ Center về Left thì bạn cho mã DXF 72 từ 1 về 0 {tức là thay (72 . 1) thành (72 . 0) }

[Snowman 92]

Để căn lề cho text, ngoài việc chỉnh mã Dfx 72, 73 còn fải chú ý đến 2 mã 10 và 11 (điểm chèn và điểm canh lề - hình như vậy). Với các text căn lề mặc định (72 . 0) (73 . 0) thì ko cần quan tâm tới mã 11 . Nhưng nếu chỉnh sửa 2 mã 72, 73 # 0 mà ko chỉnh lại mã 11 thì text sẽ bị ...bay về gốc 0. Cho nên fải thêm đoạn gán mã 11 bằng (x, y, z) mong muốn

Tham khảo đoạn hàm tạo text tùy ý dưới đây:

(defun txt_make	(contxt	   ins_po    cur_la    cur_st	 h_txt
	 ro-txt	   wf-txt    code-72   code-73	 /
	 ent_lst   cur_cl    htxt      aglpo
	)
 (if (not (tblsearch "STYLE" cur_st))
   (setq cur_st (getvar "TEXTSTYLE"))
 )
 (if (not (tblsearch "Layer" cur_la))
   (setq cur_la (getvar "CLAYER"))
 )

 (setq	ent_lst	(append	'((0 . "TEXT"))
		(list (cons 8 cur_la)
		      (cons 40 h_txt)
		      (cons 41 wf-txt)
		      (cons 7 cur_st)
		      (cons 50 ro-txt)
		      (cons 1 contxt)
		      (cons 10 ins_po)
		)
	)
 )
 (if (entmake ent_lst)
   (setq ent-txt (entlast)
  ent-lst (entget ent-txt)
  ent-lst (subst (cons 72 code-72) (assoc 72 ent-lst) ent-lst)
  ent-lst (subst (cons 73 code-73) (assoc 73 ent-lst) ent-lst)
  ent-lst (subst (cons 11 ins_po) (assoc 11 ent-lst) ent-lst)

  ent-txt (entmod ent-lst)
   )
 )

)

 

(Chú Natasa dạo này cũng thức khuya nhỉ, lại "trăn trở" chuyện vợ con ah?)

[Thaistreetz 539]

Để căn lề cho text, ngoài việc chỉnh mã Dfx 72, 73 còn fải chú ý đến 2 mã 10 và 11 (điểm chèn và điểm canh lề - hình như vậy). Với các text căn lề mặc định (72 . 0) (73 . 0) thì ko cần quan tâm tới mã 11 . Nhưng nếu chỉnh sửa 2 mã 72, 73 # 0 mà ko chỉnh lại mã 11 thì text sẽ bị ...bay về gốc 0. Cho nên fải thêm đoạn gán mã 11 bằng (x, y, z) mong muốn

Vừa hay em mới viết xong cái lisp căn lề text. Em giải quyết vấn đề này bằng cách lấy toàn bộ các thuộc tính của text được chọn, xóa text đó đi rồi viết lại text khác tại vị trí mới với nội dung và thuộc tính (Value, style, layer, color, hight text) giống hệt text cũ.

Bạn dovanlinh có thể tham khảo thêm tại đây

[kamezoko 3]

Chào kamezoko và thiep

Lisp sau Tue_NV đã viết theo ý kamezoko nhưng chưa hoàn thành.

và mình post lên để giúp cho kamezoko.

Lisp trên nối điiẻm chèn Text lại với nhau theo ý của kamezoko.

Vì Lisp trên chưa hoàn hảo nên muốn thoát bạn bấm Esc 2 lần để thoát lệnh nhé.

Bạn xài tạm vậy :

(defun c:ntdt(/ lis a ss i ent chu p x)
(setvar "cmdecho" 0)
(prompt "Chon Text :")
(setq ss (ssget '((0 . "TEXT"))) i 0 lis nil res " " lisch "")
(while (< i (sslength ss))
(setq ent (entget(ssname ss i)))
(setq chu (cdr(assoc 1 ent)))
(setq p (cdr(assoc 10 ent)))
(setq lis (append lis (list (cons chu p))))
(setq lisch (strcat lisch chu res))
(setq i (1+ i))
)

(command "line")
(foreach x lis
(initget 1 (eval lisch))
(command 
(if (setq a (assoc (getkword "\n Nhap chu : ") lis)) 
(progn
(cdr a)
)
)
)
)

(princ)
)

Nếu thiep và mọi người rảnh thì xin sửa dùm Code này lại với vì hiện giờ Tue_NV rất bận. Thanks

nhờ các anh sửa lisp này dùm em,lisp chạy tốt nhưng khi kết thúc thì nó ko nhớ các diểm đã chọn..hic..mất công chọn điểm lại khi thực hiện lệnh....mong các anh giúp đở thêm..em cám ơn :s_big: :cheers: