Viết Lisp theo yêu cầu

[xaydung 12]

Các anh ơi em đang cần 1 lisp có nội dung sau, mong các anh giúp em:

gọi là lisp lấy ra khảng cách của 2 nét gạch đứt của 1 đường hidden "- - - - -" sau đó nhập điểm chèn kết quả là 1 số trên màn hình autocad. (tức là khoảng không giữa 2 nét - - đó các anh à), thanks các bác trước!!

[tnmtpc 207]

Bạn có thể post yêu cầu về autolisp ở topic này.

Xin chào Bác Hoành, chào tất cả mọi ngừơi!

Vô cùng khâm phục Bác Hoành, vô cùng cám ơn diễn dàn Cadviet!

Thông qua diễn đàn, tôi được mở mang thêm cái đầu mê muội bấy lâu. Thật là tuyệt vời.

Qua cuộc trao đổi về lisp giữa Bác Hoành, Ssg và VBao về đề tài nối text, tôi nảy ra ý kiến nhờ Bác Hòanh, Ssg hỗ trợ

VBao đúng là dân trắc địa rôì! nhưng yêu cầu cuả VBao đặt ra để Bác Hoành và Bác Ssg viết lisp là chưa giaỉ quyết "tận gốc", nghĩa là khi muốn nối text ( thực ra là nôí điểm) vẫn phải thao tác nhập lệnh nhiều lần và sẽ gặp rắc rối là không phải lúc nào cũng nối điểm theo qui luật thứ tự cuả điểm. Do vậy tôi nghĩ rằng phải có một yêu cầu thực tế hơn, nhờ Bác Hoành, Ssg nghiên cứu giúp. Cụ thể như sau:

Trên bản vẽ Cad có các điểm mia nằm trên lớp "diem", tên các điểm mia là 1,2,3,4...hoặc C1,C2,C3...(tên do ngừơi dùng đặt ra) nằm trên lớp "tendiem", code điểm là Jx nằm trên lớp "code" (x là tên điểm mia mà nó cần nối tới), khi thực hiện lệnh nối điểm, chương trình tự động nôi điểm có mã Jx tới điểm có tên điểm mia x. Tọa độ điểm chèn text của tên điểm trùng với điểm mia, tọa độ điểm chèn text của code nằm dứơi điểm mia và cách điểm mia đúng bằng chiều cao text.

Mong Bác Hoành viết giúp lisp. Cám ơn lắm lắm!

[captainbo 0]

Xin chào các anh!

Em đang tập viết Lisp nên rất vui mừng khi tham gia diễn đàn

Em đang bí 1 vấn đề

- Yêu cầu nhập text cần tìm (chỉ chứa 1 từ trong cụm từ VD cần tìm từ "Dien" trong "Dien tich" chang han)

- Chọn toàn bộ đối tượng đã tìm được

Xin chân thành cảm ơn

[ssg 1.102]

Xin chào các anh!

Em đang tập viết Lisp nên rất vui mừng khi tham gia diễn đàn

Em đang bí 1 vấn đề

- Yêu cầu nhập text cần tìm (chỉ chứa 1 từ trong cụm từ VD cần tìm từ "Dien" trong "Dien tich" chang han)

- Chọn toàn bộ đối tượng đã tìm được

Xin chân thành cảm ơn

Bạn thử đoạn sau. Kết quả sau khi chọn và lọc là ss2. Dòng command "move" cuối cùng là để bạn test chương trình.

 

(defun C:FINT( / t1 ss ss2 t2 e);;;Find Texts by a part
(setq
t1 (getstring "\Input a part of text:")
ss (ssget "X" '((0 . "TEXT")))
ss2 (ssadd)
)
(while (setq e (ssname ss 0))
(setq t2 (cdr (assoc 1 (entget e))))
(if (vl-string-search t1 t2) (setq ss2 (ssadd e ss2))) 
(ssdel e ss)
)
(command "move" ss2 "" pause);;;Test
)

[pikeman286 244]

các bác giúp em với.cai lisp này vẽ chỉ dẫn mà sao em load hoài mà không chạy được.Xem giùm em xem bị sai chỗ nào.

;chuongtrinhvechidan
;author:LCT
;phan nhap du lieu
(prompt "\nnhap du lieu.\n")
(setvar "cmdecho" 0)
(defun C:vcd (/ O R H A B N K)
(setq 	O (getpoint "\nnhap toa do tam duong tron:"))
(setq	R (getreal "\nnhap ban kinh duong tron:"))
(setq	A (getpoint "\nnhap toa do diem dau leader:"))
(setq	B (polar A (angle A O)(- (distance A O) R)))
(setq	H (getint "\nnhap chieu cao text:"))
(setq 	N (getreal "\nnhap goc nghieng cua text:"))
(setq 	K (getreal "\nnhap text:")))
;cac lenh ve
(command ".circle" O R )
(command ".text" "m" O H N K 1)
(command ".dim" "lea" A B )
^C ^C
(command ".zoom" "a")
)
)
;ket thuc

[ssg 1.102]

các bác giúp em với.cai lisp này vẽ chỉ dẫn mà sao em load hoài mà không chạy được.Xem giùm em xem bị sai chỗ nào.

;chuongtrinhvechidan
;author:LCT
;phan nhap du lieu
(prompt "\nnhap du lieu.\n")
(setvar "cmdecho" 0)
(defun C:vcd (/ O R H A B N K)
(setq 	O (getpoint "\nnhap toa do tam duong tron:"))
(setq	R (getreal "\nnhap ban kinh duong tron:"))
(setq	A (getpoint "\nnhap toa do diem dau leader:"))
(setq	B (polar A (angle A O)(- (distance A O) R)));;;Thiếu dấu cách
(setq	H (getint "\nnhap chieu cao text:"))
(setq 	N (getreal "\nnhap goc nghieng cua text:"))
(setq 	K (getreal "\nnhap text:")))
;cac lenh ve
(command ".circle" O R )
(command ".text" "m" O H N K 1)
(command ".dim" "lea" A B )
^C ^C;;;Không hợp lệ
(command ".zoom" "a")
)
);;;Thừa dấu đóng ngoặc
;ket thuc

- Sai cú pháp ở 3 chỗ đánh dấu trên

- Cung cách giao tiếp với người dùng không tốt

- Chưa rõ lắm mục đích của chương trình. Bạn diễn giải kỹ hơn (tốt nhất là up lên file *.dwg ví dụ), mình sẽ góp ý để bạn sửa.

[pikeman286 244]

- Sai cú pháp ở 3 chỗ đánh dấu trên

- Cung cách giao tiếp với người dùng không tốt

- Chưa rõ lắm mục đích của chương trình. Bạn diễn giải kỹ hơn (tốt nhất là up lên file *.dwg ví dụ), mình sẽ góp ý để bạn sửa.

Đây.bác xem zum em cái.

http://i255.photobucket.com/albums/hh144/p.../bangchidan.jpg

cái này là vẽ chú thích cho các đối tượng.

[ssg 1.102]

Đây.bác xem zum em cái.

http://i255.photobucket.com/albums/hh144/p.../bangchidan.jpg

cái này là vẽ chú thích cho các đối tượng.

Link error, không down được! Hơn nữa, bạn up file *.dwg thì hay hơn. File *.dwg nói lên nhiều điều gấp trăm lần dạng *.jpg. Bạn không cần giải thích gì nhiều nhưng người đọc vẫn hiểu chính xác vấn đề.

 

P/S: Vừa down được rồi, chắc là lỗi đường truyền. Nhưng vẫn chưa hiểu! Bạn up lại bằng file *.dwg và giải thích rõ hơn đi.

Chẳng hạn, trên hình mình thấy 3 đối tượng text: 1.2, B, A. Trong khi chương trình của bạn chỉ có 1 dòng (setq K...) ?

[pikeman286 244]

Link error, không down được! Hơn nữa, bạn up file *.dwg thì hay hơn. File *.dwg nói lên nhiều điều gấp trăm lần dạng *.jpg. Bạn không cần giải thích gì nhiều nhưng người đọc vẫn hiểu chính xác vấn đề.

 

P/S: Vừa down được rồi, chắc là lỗi đường truyền. Nhưng vẫn chưa hiểu! Bạn up lại bằng file *.dwg và giải thích rõ hơn đi.

Chẳng hạn, trên hình mình thấy 3 đối tượng text: 1.2, B, A. Trong khi chương trình của bạn chỉ có 1 dòng (setq K...) ?

Chính xác là em phải nhập nhiều những ký tự chỉ dẫn này.Các ký tự A B K chỉ là em đánh mốc cho hình đễ dẽ nhìn thôi.Mà cú quá không biết sửa cách nào.Em Up file lên cho bác đây.Xem giùm em cái.

http://www.mediafire.com/?25jwpth2mgb

[ssg 1.102]

Chính xác là em phải nhập nhiều những ký tự chỉ dẫn này.Các ký tự A B K chỉ là em đánh mốc cho hình đễ dẽ nhìn thôi.Mà cú quá không biết sửa cách nào.Em Up file lên cho bác đây.Xem giùm em cái.

http://www.mediafire.com/?25jwpth2mgb

Bạn chạy thử chương trình sau:

 

;;;-------------------------------------------------------
(defun wtxtMC (txt p / sty d h1 h2) ;;;Write txt on graphic screen, Middle Center
(setq
   sty (getvar "textstyle")
   d (tblsearch "style" sty)
   h1 (cdr (assoc 40 d))
   h2 (cdr (assoc 42 d))
)
(if (> h1 0) (command "text" "j" "mc" p 0 txt)
   (command "text" "j" "mc" p h2 0 txt)
)
)
;;;-------------------------------------------------------
(defun C:VCD (/ txt R O A B oldos)
(setq
   txt (getstring "\nText chu dan:")
   R (getreal "\nBan kinh duong tron:")
   O (getpoint "\nTam duong tron:")
   A (getpoint O "\nDiem dau leader:")
   B (polar A (angle A O) (- (distance A O) R))
   oldos (getvar "osmode")
)
(setvar "osmode" 0)
(command "circle" O R )
(command "leader" A B "" "" "N")
(wtxtMC txt O)
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------

 

Có mấy vấn đề góp ý:

1) Thủ tục viết text ra màn hình có vẻ đơn giản vậy nhưng tồn tại một vấn đề phiền toái. Cụ thể bạn tham khảo ở đây:

 

http://www.cadviet.com/forum/index.php?showtopic=2291

 

Bạn mới làm quen với lisp, nếu chưa hiểu rõ lắm thì cứ dùng hàm (wtxtMC txt p) đã xây dựng ở trên. Nó sẽ viết text txt (kiểu string) tại điểm p với align MC (middle center)

2) Lần trước mình có nói "cung cách giao tiếp với người dùng không tốt" là ở chỗ bạn bắt người dùng phải nhập số liệu nhiều quá (độ cao text, góc nghiêng text...). Có cần thiết như vậy không? Với function wtxtMC trên, nó sẽ lấy textstyle hiện hành để thực hiện (y như người dùng gọi lệnh text). Trường hợp đặc biệt, cần quy định h = textheigh khác, nếu không nghiêm ngặt lắm thì nên lấy h0 = textheigh hiện hành làm chuẩn và tự động tính h theo h0. Kể cả bán kính vòng tròn, theo mình bạn cũng nên quy định luôn theo h0 thì hay hơn. Tóm lại là cố gắng yêu cầu người dùng nhập số liệu càng ít càng tốt. Nếu có thể, chỉ cần 3 số liệu:

- Nội dung chú dẫn

- Điểm đầu leader

- Tâm đường tròn

Các yếu tố khác bạn tự quy định một cách hài hoà, hợp lý nhất theo h0 và để chương trình tính tự động.

3) Mình nhắc bạn post file *.dwg tức là file bản vẽ thực tế, với đầy đủ các yếu tố, sau khi trình lisp (đang xây dựng) của bạn chạy xong. File đầy đủ giúp mình hiểu rõ hơn về:

- Chương trình áp dụng cho chuyên ngành nào (kiến trúc, xây dựng, cơ khí, trắc địa...)?

- Chương trình thực hiện các động tác trên chỉ 1 lần hay là nhiều lần? Số lần lặp lại khoảng chừng bao nhiêu?

- Mật độ dày đặc các đối tượng trên bản vẽ ở mức nào?

- Kích thước file bản vẽ khoảng bao nhiêu?

- Các thông sô thiết lập về layer, textstyle, dimstyle như thế nào?

- v.v... và v.v...

Tất cả những cái nói trên, bạn tưởng là không liên quan gì, nhưng thật ra chúng đều rất quan trọng đối với lập trình viên, khi xây dựng thuật giải cũng như định hướng ban đầu để lập nên cái "khung sườn" cho chương trình một cách hợp lý nhất.

[4582 0]

Xin nói lại 1 chút: line không bao giờ có width, chỉ có pline mới có width.

 

Lệnh MA của các ACAD đời mới đều matchprop được cả bề dày (tôi đang sử dụng ACAD2007).

Bạn nên cài ACAD đời mới nhất. Vì nếu tắt các chức năng về hiển thị màu mè, mờ ảo, nó vẫn nhẹ như ACAD2000, nhưng nhiều tính năng mới hơn.

Bạn Nguyen Hoanh ơi, cho mình hỏi một chút. Mình đang sử dụng cad 2007, cấu hình của máy cũng tương đối. Nhưng không hiểu sao khi làm việc với cad thấy rất chậm, chẳng hạn như khi muốn chọn text để edit cũng phải đợi một lúc, rất khó chịu. Bạn chỉ giúp mình nhé, thank bạn rất nhiều!

[binladen_mrp 7]

Các bác ah.Làm sao mà vẽ được ký hiệu đất tự nhiên nhanh đựơc ah http://www.cadviet.com/upfiles/Drawing4_1.dwg

.chứ ngồi copy thì mệt chết mà còn lại sấu nữa.co cái lisp vẽ không các bác .các bác giúp em với nhé.cảm ơn các bác .

[pikeman286 244]

Có mấy vấn đề góp ý:

1) Thủ tục viết text ra màn hình có vẻ đơn giản vậy nhưng tồn tại một vấn đề phiền toái. Cụ thể bạn tham khảo ở đây:

 

http://www.cadviet.com/forum/index.php?showtopic=2291

 

Bạn mới làm quen với lisp, nếu chưa hiểu rõ lắm thì cứ dùng hàm (wtxtMC txt p) đã xây dựng ở trên. Nó sẽ viết text txt (kiểu string) tại điểm p với align MC (middle center)

2) Lần trước mình có nói "cung cách giao tiếp với người dùng không tốt" là ở chỗ bạn bắt người dùng phải nhập số liệu nhiều quá (độ cao text, góc nghiêng text...). Có cần thiết như vậy không? Với function wtxtMC trên, nó sẽ lấy textstyle hiện hành để thực hiện (y như người dùng gọi lệnh text). Trường hợp đặc biệt, cần quy định h = textheigh khác, nếu không nghiêm ngặt lắm thì nên lấy h0 = textheigh hiện hành làm chuẩn và tự động tính h theo h0. Kể cả bán kính vòng tròn, theo mình bạn cũng nên quy định luôn theo h0 thì hay hơn. Tóm lại là cố gắng yêu cầu người dùng nhập số liệu càng ít càng tốt. Nếu có thể, chỉ cần 3 số liệu:

- Nội dung chú dẫn

- Điểm đầu leader

- Tâm đường tròn

Các yếu tố khác bạn tự quy định một cách hài hoà, hợp lý nhất theo h0 và để chương trình tính tự động.

3) Mình nhắc bạn post file *.dwg tức là file bản vẽ thực tế, với đầy đủ các yếu tố, sau khi trình lisp (đang xây dựng) của bạn chạy xong. File đầy đủ giúp mình hiểu rõ hơn về:

- Chương trình áp dụng cho chuyên ngành nào (kiến trúc, xây dựng, cơ khí, trắc địa...)?

- Chương trình thực hiện các động tác trên chỉ 1 lần hay là nhiều lần? Số lần lặp lại khoảng chừng bao nhiêu?

- Mật độ dày đặc các đối tượng trên bản vẽ ở mức nào?

- Kích thước file bản vẽ khoảng bao nhiêu?

- Các thông sô thiết lập về layer, textstyle, dimstyle như thế nào?

- v.v... và v.v...

Tất cả những cái nói trên, bạn tưởng là không liên quan gì, nhưng thật ra chúng đều rất quan trọng đối với lập trình viên, khi xây dựng thuật giải cũng như định hướng ban đầu để lập nên cái "khung sườn" cho chương trình một cách hợp lý nhất.

Em hiểu bác muốn nói gì.Đây chính là những khó khăn lớn nhất của em khi băt đầu bước vào học lisp.Đúng là cần phải điều chỉnh lại cung cách lập trình nhiều.Cảm ơn bác đã quan tâm.

[binladen_mrp 7]

Các bác ah.Làm sao mà vẽ được ký hiệu đất tự nhiên nhanh đựơc ah http://www.cadviet.com/upfiles/Drawing4_1.dwg

.chứ ngồi copy thì mệt chết mà còn lại sấu nữa.co cái lisp vẽ không các bác .các bác giúp em với nhé.cảm ơn các bác .

ôi kô có bác nào giúp em àh?????????

[xaydung 12]

Anh ơi , em muốn xin 1 lisp layer current có nội dung như sau:

giả sử lớp trên màn hình hiện thời là lớp "tường" ,

chạy lisp hỏi chọn đối tượng

pick vào 1 đối tượng bất kỳ giả sử nó thuộc lớp khác là cửa, thì kết qủa là lớp cửa trở thành lớp hiện hành với 1 chú ý là màu của lớp này lấy theo màu của đối tượng chọn!

[ssg 1.102]

Anh ơi , em muốn xin 1 lisp layer current có nội dung như sau:

giả sử lớp trên màn hình hiện thời là lớp "tường" ,

chạy lisp hỏi chọn đối tượng

pick vào 1 đối tượng bất kỳ giả sử nó thuộc lớp khác là cửa, thì kết qủa là lớp cửa trở thành lớp hiện hành với 1 chú ý là màu của lớp này lấy theo màu của đối tượng chọn!

Trên quan điểm tiêu chuẩn hoá bản vẽ, người ta thường quy định mỗi layer 1 màu. Những bản vẽ đã "lỡ" gán màu lung tung, người ta còn cố gắng đưa chúng về chuẩn thống nhất, tương tự như chương trình của aboutautolisp. Trong khi bạn thì làm ngược lại!

Lisp này rất đơn giản, nhưng e rằng không ai muốn làm. Bạn thông cảm nhé.

[ssg 1.102]

ôi kô có bác nào giúp em àh?????????

Bạn đã tạo thành block, chỉ insert vào thôi mà? Nếu muốn nhiều block đều nhau, thay vì copy thì bạn dùng array?

[Nguyen Hoanh 4.663]

Xin chào Bác Hoành, chào tất cả mọi ngừơi!

Vô cùng khâm phục Bác Hoành, vô cùng cám ơn diễn dàn Cadviet!

Thông qua diễn đàn, tôi được mở mang thêm cái đầu mê muội bấy lâu. Thật là tuyệt vời.

Qua cuộc trao đổi về lisp giữa Bác Hoành, Ssg và VBao về đề tài nối text, tôi nảy ra ý kiến nhờ Bác Hòanh, Ssg hỗ trợ

VBao đúng là dân trắc địa rôì! nhưng yêu cầu cuả VBao đặt ra để Bác Hoành và Bác Ssg viết lisp là chưa giaỉ quyết "tận gốc", nghĩa là khi muốn nối text ( thực ra là nôí điểm) vẫn phải thao tác nhập lệnh nhiều lần và sẽ gặp rắc rối là không phải lúc nào cũng nối điểm theo qui luật thứ tự cuả điểm. Do vậy tôi nghĩ rằng phải có một yêu cầu thực tế hơn, nhờ Bác Hoành, Ssg nghiên cứu giúp. Cụ thể như sau:

Trên bản vẽ Cad có các điểm mia nằm trên lớp "diem", tên các điểm mia là 1,2,3,4...hoặc C1,C2,C3...(tên do ngừơi dùng đặt ra) nằm trên lớp "tendiem", code điểm là Jx nằm trên lớp "code" (x là tên điểm mia mà nó cần nối tới), khi thực hiện lệnh nối điểm, chương trình tự động nôi điểm có mã Jx tới điểm có tên điểm mia x. Tọa độ điểm chèn text của tên điểm trùng với điểm mia, tọa độ điểm chèn text của code nằm dứơi điểm mia và cách điểm mia đúng bằng chiều cao text.

Mong Bác Hoành viết giúp lisp. Cám ơn lắm lắm!

Bạn có thể có thể upload 1 file dwg mẫu được không?

Trong đó thể hiện: Trạng thái trước khi sử dụng lệnh và trạng thái sau khi sử dụng lệnh (các line nối được thêm vào).

 

P/S: có thể cách nói khác nhau, nhưng tôi thấy cách nói 'điểm mia nằm trong layer "diem"' đỡ lẫn hơn là 'điểm mia nằm trên lớp "diem"' vì thuật ngữ layer đã trở nên quá quen thuôc trong AutoCAD (bạn dùng thuật ngữ 'lớp', tôi luận 1 lúc mới hiểu).

[tnmtpc 207]

Bạn có thể có thể upload 1 file dwg mẫu được không?

Trong đó thể hiện: Trạng thái trước khi sử dụng lệnh và trạng thái sau khi sử dụng lệnh (các line nối được thêm vào).

 

P/S: có thể cách nói khác nhau, nhưng tôi thấy cách nói 'điểm mia nằm trong layer "diem"' đỡ lẫn hơn là 'điểm mia nằm trên lớp "diem"' vì thuật ngữ layer đã trở nên quá quen thuôc trong AutoCAD (bạn dùng thuật ngữ 'lớp', tôi luận 1 lúc mới hiểu).

Cám ơn Bác Hoành đã quan tâm, tối mai tôi gửi 1 file dwg nhờ Bác giúp( Bác thông cảm, từ ngữ mình nó "thuần Việt" quá

[tnmtpc 207]

Bạn có thể có thể upload 1 file dwg mẫu được không?

Trong đó thể hiện: Trạng thái trước khi sử dụng lệnh và trạng thái sau khi sử dụng lệnh (các line nối được thêm vào).

 

P/S: có thể cách nói khác nhau, nhưng tôi thấy cách nói 'điểm mia nằm trong layer "diem"' đỡ lẫn hơn là 'điểm mia nằm trên lớp "diem"' vì thuật ngữ layer đã trở nên quá quen thuôc trong AutoCAD (bạn dùng thuật ngữ 'lớp', tôi luận 1 lúc mới hiểu).

Gửi Bác Hòanh file mẫu theo gợi ý của Bác. Xin nêu một chút cho cụ thể là điểm chèn text của tên điểm (M1, M2...) và code (jM1, jM2...) trùng vơí tọa độ điểm mia, chỉ có khác là tên điểm ở TL, code ở BL, chiều cao text bây giờ không quan tâm nưã bác ạ! Cám ơn Bác Hoành nhiều

http://www.cadviet.com/upfiles/mau.rar

[Nguyen Hoanh 4.663]

Gửi Bác Hòanh file mẫu theo gợi ý của Bác. Xin nêu một chút cho cụ thể là điểm chèn text của tên điểm (M1, M2...) và code (jM1, jM2...) trùng vơí tọa độ điểm mia, chỉ có khác là tên điểm ở TL, code ở BL, chiều cao text bây giờ không quan tâm nưã bác ạ! Cám ơn Bác Hoành nhiều

http://www.cadviet.com/upfiles/mau.rar

 

Lệnh là JD (Joint các Điểm).

 

Chương trình yêu cầu bạn nhập các đối tượng vào (lẫn lộn cả point và text). Chương trình tự phân biệt đâu là point, đâu là tên điểm và đâu là code rồi thực thi như yêu cầu của bạn.

 

Text không cần trùng điểm chèn với point mà chỉ cần gần point là chương trình nhận biết được.

 

(defun c:jd ()
 (setq
   ss         (ssget
	 '((-4 . "		   (-4 . "")
	   (-4 . "")
	   (-4 . "")
	   (-4 . "OR>")
	  )
       )
   lstent     (ss2ent ss)

   lsttendiem (mapcar '(lambda	(e)
		  (cons	(cdr (assoc 10 (entget e)))
			(cdr (assoc 1 (entget e)))
		  )
		)
	       (filter lstent "TEXT" "TENDIEM")
       )
   lstcode    (mapcar '(lambda	(e)
		  (cons	(cdr (assoc 10 (entget e)))
			(cdr (assoc 1 (entget e)))
		  )
		)
	       (filter lstent "TEXT" "CODE")
       )
   lstpoint   (mapcar '(lambda (e) (cdr (assoc 10 (entget e))))
	       (filter lstent "POINT" "DIEM")
       )
   lstpoint   (mapcar '(lambda	(p)
		  (cons (timgan p lsttendiem) p)
		)
	       lstpoint
       )
 )
 (foreach pp lstcode
   (setq
     pc       (car pp)
     tendiem (timgan pc lsttendiem)
     code    (cdr pp)
     p       (cdr (assoc tendiem lstpoint))      
     lstc (explode (substr code 2) "-")
   )

   (foreach cc	lstc
     (setq f (assoc cc lstpoint))
     (if f
(progn
  (setq p0 (cdr f))
  (makeline p0 p)
)
     )
   )
 )

 (princ)
)
 (defun timgan	(p lst / dmin ppluu)
   (foreach pp	lst
     (setq d (distance p (car pp)))
     (if (or (not dmin) (> dmin d))
(setq
  dmin d
  ppluu	pp
)
     )
   )
   (cdr ppluu)
 )

(defun filter(lstent otype olayer / kq)
 (foreach pp lstent
    (setq tt (entget pp))
    (if (and
   (member (cons 0 otype) tt)
   (member (cons 8 olayer) tt)
 )
      (setq kq (append kq (list pp)))
    )
 )
 kq
)

(defun pos (sub st / l1 l2 index)
 (setq	index 1
l1    (strlen sub)
l2    (strlen st)
 )
 (while
   (and (     (setq index (1+ index))
 )
 (if (= sub (substr st index l1))
   index
   nil
 )
)

(defun explode (str sep / kq)
 (setq kq nil)
 (while (setq vt (pos sep str))
   (setq
     kq  (append kq (list (substr str 1 (1- vt))))
     str (substr str (1+ vt))
   )
 )
 (setq kq (append kq (list str)))
 kq
)

(defun makeline	(p1 p2)
 (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)

(defun ss2ent(ss / sodt index lstent)
 (setq
   sodt (if ss (sslength ss) 0)	   
   index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
  index (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)

[thanhlamct 70]

ôi kô có bác nào giúp em àh?????????

Bạn nên xem lệnh ME, lệnh này rất hay khi muốn chèn Block theo tuyến đấy.

[tnmtpc 207]

Lệnh là JD (Joint các Điểm).

 

Chương trình yêu cầu bạn nhập các đối tượng vào (lẫn lộn cả point và text). Chương trình tự phân biệt đâu là point, đâu là tên điểm và đâu là code rồi thực thi như yêu cầu của bạn.

 

Text không cần trùng điểm chèn với point mà chỉ cần gần point là chương trình nhận biết được.

 

(defun c:jd ()
 (setq
   ss         (ssget
	 '((-4 . "<OR")
	   (-4 . "<AND")(0 . "POINT") (8 . "DIEM")(-4 . "AND>")
	   (-4 . "<AND")(0 . "TEXT") (8 . "TENDIEM")(-4 . "AND>")
	   (-4 . "<AND")(0 . "TEXT") (8 . "CODE")(-4 . "AND>")
	   (-4 . "OR>")
	  )
       )
   lstent     (ss2ent ss)

   lsttendiem (mapcar '(lambda	(e)
		  (cons	(cdr (assoc 10 (entget e)))
			(cdr (assoc 1 (entget e)))
		  )
		)
	       (filter lstent "TEXT" "TENDIEM")
       )
   lstcode    (mapcar '(lambda	(e)
		  (cons	(cdr (assoc 10 (entget e)))
			(cdr (assoc 1 (entget e)))
		  )
		)
	       (filter lstent "TEXT" "CODE")
       )
   lstpoint   (mapcar '(lambda (e) (cdr (assoc 10 (entget e))))
	       (filter lstent "POINT" "DIEM")
       )
   lstpoint   (mapcar '(lambda	(p)
		  (cons (timgan p lsttendiem) p)
		)
	       lstpoint
       )
 )
 (foreach pp lstcode
   (setq
     pc       (car pp)
     tendiem (timgan pc lsttendiem)
     code    (cdr pp)
     p       (cdr (assoc tendiem lstpoint))      
     lstc (explode (substr code 2) "-")
   )

   (foreach cc	lstc
     (setq f (assoc cc lstpoint))
     (if f
(progn
  (setq p0 (cdr f))
  (makeline p0 p)
)
     )
   )
 )

 (princ)
)
 (defun timgan	(p lst / dmin ppluu)
   (foreach pp	lst
     (setq d (distance p (car pp)))
     (if (or (not dmin) (> dmin d))
(setq
  dmin d
  ppluu	pp
)
     )
   )
   (cdr ppluu)
 )

(defun filter(lstent otype olayer / kq)
 (foreach pp lstent
    (setq tt (entget pp))
    (if (and
   (member (cons 0 otype) tt)
   (member (cons 8 olayer) tt)
 )
      (setq kq (append kq (list pp)))
    )
 )
 kq
)

(defun pos (sub st / l1 l2 index)
 (setq	index 1
l1    (strlen sub)
l2    (strlen st)
 )
 (while
   (and (<= (+ index l1 -1) l2) (/= sub (substr st index l1)))
    (setq index (1+ index))
 )
 (if (= sub (substr st index l1))
   index
   nil
 )
)

(defun explode (str sep / kq)
 (setq kq nil)
 (while (setq vt (pos sep str))
   (setq
     kq  (append kq (list (substr str 1 (1- vt))))
     str (substr str (1+ vt))
   )
 )
 (setq kq (append kq (list str)))
 kq
)

(defun makeline	(p1 p2)
 (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)

(defun ss2ent(ss / sodt index lstent)
 (setq
   sodt (if ss (sslength ss) 0)	   
   index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
  index (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)

Bác Hoành xem lại giúp, tôi thực hiện trên file mẫu, sau khi nhập lệnh, chọn đôí tượng, chương trình báo lỗi:

error: null function

(POS SEP STR)

(SETQ VT (POS SEP STR))

(WHILE (SETQ VT (POS SEP STR)) (SETQ KQ (APPEND KQ (LIST (SUBSTR STR 1 (1-

VT)))) STR (SUBSTR STR (1+ VT))))

(EXPLODE (SUBSTR CODE 2) "-")

(SETQ PC (CAR PP) TENDIEM (TIMGAN PC LSTTENDIEM) CODE (CDR PP) P (CDR (ASSOC

TENDIEM LSTPOINT)) LSTC (EXPLODE (SUBSTR CODE 2) "-"))

(FOREACH PP LSTCODE (SETQ PC (CAR PP) TENDIEM (TIMGAN PC LSTTENDIEM) CODE (CDR

PP) P (CDR (ASSOC TENDIEM LSTPOINT)) LSTC (EXPLODE (SUBSTR CODE 2) "-"))

(FOREACH CC LSTC (SETQ F (ASSOC CC LSTPOINT)) (IF F (PROGN (SETQ P0 (CDR F))

(MAKELINE P0 P)))))

(C:JD)

*Cancel*

Không thấy line nào xuất hiện cả bác ạ!

[ssg 1.102]

Bác Hoành xem lại giúp, tôi thực hiện trên file mẫu, sau khi nhập lệnh, chọn đôí tượng, chương trình báo lỗi:

...

Không thấy line nào xuất hiện cả bác ạ!

Mình chạy thử trên file mẫu của bạn, kết quả: OK! Bạn thử lại xem sao.

Lưu ý:

1) Vô hiệu hóa tất cả các trình lisp khác đang chạy (nếu có) của bạn. Bạn có dùng trình lisp nào đặt ở chế độ autoload không?

2) Sau khi load file, bấm F2 xem nó có báo gì khác ngoài dòng "...successfully loaded" không? Nếu có tức là không ổn, bạn đã thao tác sai cái gì đó không biết!

[tnmtpc 207]

Mình chạy thử trên file mẫu của bạn, kết quả: OK! Bạn thử lại xem sao.

Lưu ý:

1) Vô hiệu hóa tất cả các trình lisp khác đang chạy (nếu có) của bạn. Bạn có dùng trình lisp nào đặt ở chế độ autoload không?

2) Sau khi load file, bấm F2 xem nó có báo gì khác ngoài dòng "...successfully loaded" không? Nếu có tức là không ổn, bạn đã thao tác sai cái gì đó không biết!

Mình sẽ xem lại, nhưng mình vẫn load file bình thường, không có gì lạ xảy ra cả, gõ lệnh, nhắc chọn đối tượng, chọn xong, Enter, báo lỗi như trên