Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
NguyenNgocSon

[Yêu cầu]Lisp lấy text gần block

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

Em có một bài toán như sau:

Cho các block trong bản vẽ

Lisp yêu cầu: chọn block cần chọn

Sau đó sẽ lấy text gần block nhất và thống kê ra bảng Excel hoặc text

Cám ơn !@

Thân.http://www.cadviet.com/upfiles/3/48467_binh_dod28d30d32.dwg

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
Doan Van Ha    2.676

Em có một bài toán như sau:

Cho các block trong bản vẽ

Lisp yêu cầu: chọn block cần chọn

Sau đó sẽ lấy text gần block nhất và thống kê ra bảng Excel hoặc text

Cám ơn !@

Thân.http://www.cadviet.c...dod28d30d32.dwg

Câu hỏi của bạn chưa rõ lắm:

- Xuất những thứ gì ra file? Thứ tự như thế nào?

- Trên bản vẽ có nhiều kiểu text/mtext thì chọn kiểu nào?

- "Gần" block có phải là gần điểm chèn nhất?

- Chọn nhiều block hay 1?

v.v...

  • 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

Câu hỏi của bạn chưa rõ lắm:

- Xuất những thứ gì ra file? Thứ tự như thế nào?

- Trên bản vẽ có nhiều kiểu text/mtext thì chọn kiểu nào?

- "Gần" block có phải là gần điểm chèn nhất?

- Chọn nhiều block hay 1?

v.v...

Trước tiên cám ơn ĐVH đã quan tâm. Thứ lỗi vì yêu cầu không đầy đủ

- Lisp chọn toàn bộ block trên bản vẽ. Theo thứ tự từ trái qua phải, từ trên xuông dưới. Ứng với mỗi thứ tự này lisp sẽ đánh STT các block này sau đó sẽ chọn text gần điểm chèn của block nhất.

- Sau đó lisp xuất ra thứ tự các block và cột bên cạnh là text tương ứng với block đó.

Cám ơn !

Thân.

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
Doan Van Ha    2.676

Trước tiên cám ơn ĐVH đã quan tâm. Thứ lỗi vì yêu cầu không đầy đủ

- Lisp chọn toàn bộ block trên bản vẽ. Theo thứ tự từ trái qua phải, từ trên xuông dưới. Ứng với mỗi thứ tự này lisp sẽ đánh STT các block này sau đó sẽ chọn text gần điểm chèn của block nhất.

- Sau đó lisp xuất ra thứ tự các block và cột bên cạnh là text tương ứng với block đó.

Cám ơn !

Thân.

Viết gần xong thì xuất hiện thêm 1 vấn đề: khi 2 block cùng gần 1 text thì 2 block đó có cho phép lấy cùng giá trị text đó không?

  • 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

Viết gần xong thì xuất hiện thêm 1 vấn đề: khi 2 block cùng gần 1 text thì 2 block đó có cho phép lấy cùng giá trị text đó không?

Cám ơn bác! Vì là gần điểm chèn nhất nên cho phép lấy cùng giá trị text!

Thân.

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
Doan Van Ha    2.676

Cám ơn bác! Vì là gần điểm chèn nhất nên cho phép lấy cùng giá trị text!

Thân.

Đây bạn! Tôi mới test sơ sơ. Bạn test kỹ xem nhé!

(defun C:HA( / ent1 ent2 lay1 lay2 ss lst1 lst2 lstpt i kc lst3 fn pw)
(setq ent1 (car (entsel "\nChon Block lam mau: ")) ent2 (car (entsel "\nChon Text cao do lam mau: ")))
(setq lay1 (cdr (assoc 8 (entget ent1))) lay2 (cdr (assoc 8 (entget ent2))) sty2 (cdr (assoc 7 (entget ent2))) hgt2 (cdr (assoc 40 (entget ent2))))
(princ "\nChon tap hop cac Block va Text cao do...")
(setq ss (ssget (list (cons -4 "<OR")
                              	(cons -4 "<AND") (cons 0 "INSERT") (cons 8 lay1) (cons -4 "AND>")
                              	(cons -4 "<AND") (cons 0 "TEXT") (cons 8 lay2) (cons 1 "~*[~0-9`.]*") (cons 1 "*[0-9].[0-9]*") (cons -4 "AND>")
                              	(cons -4 "OR>"))))
(setq lst1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (Laydt ss "INSERT")))))
(setq lst2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (Laydt ss "TEXT")))))
(foreach ent lst1
 (setq lstpt (cons (cdr (assoc 10 (entget ent))) lstpt)))
(setq lstpt (sort1b lstpt))
(setq i 1)
(foreach p lstpt
 (entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 hgt2) (cons 62 1) (cons 1 (itoa i))))
 (setq i (1+ i)))
(setq i 1)
(foreach p lstpt
 (setq kc (distance p (cdr (assoc 10 (entget (car lst2))))) n (cdr (assoc 1 (entget (car lst2)))))
 (foreach ent lst2
  (if (< (distance p (cdr (assoc 10 (entget ent)))) kc)
(setq kc (distance p (cdr (assoc 10 (entget ent)))) n (cdr (assoc 1 (entget ent))))))
 (setq lst3 (cons (list (itoa i) n) lst3))
 (setq i (1+ i)))
(setq lst3 (reverse lst3))
(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
(setq pw (open fn "w"))
(princ (strcat "STT" "\t" "Cao do" "\n") pw)
(foreach pt lst3
 (princ (strcat (car pt) "\t" (cadr pt) "\n") pw))
(close pw)
(princ))
;----- Chon tap hop chon theo kieu doi tuong.
(defun Laydt(ss kieu)
(acet-list-to-ss (vl-remove-if '(lambda(x) (null (wcmatch (acet-dxf 0 (entget x)) kieu))) (acet-ss-to-list ss))))
;----- S¾p xÕp c¸c pt theo X t¨ng dÇn, nÕu X b»ng nhau th× xÕp gi¶m dÇn theo Y (lis cò dµi = lis míi).
(defun SORT1B(lis) (cond ((<= (length lis) 1) lis) (T (com1b (car lis) (sort1b (cdr lis))))))
(defun com1b(lis1 lis) (cond ((null lis) (list lis1)) ((< (car lis1) (car (car lis))) (cons lis1 lis)) ((and (= (car lis1)  (car (car lis))) (> (cadr lis1) (cadr (car lis)))) (cons lis1 lis)) (T (cons (car lis) (com1b lis1 (cdr lis))))))

  • 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

Cám ơn ĐVH nhiều. Mình check thấy lisp chạy khá tốt.

Nhưng để tiện theo dõi thì nên thêm tính năng đánh STT ( text) của các block được chọn bên cạnh block đó luôn thì dễ theo dõi hơn với bản vẽ có nhiều block? Ví dụ như là: G1 đến Gn sau đó mới xuất ra file.

Chân thành cám ơn !

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
Doan Van Ha    2.676

Cám ơn ĐVH nhiều. Mình check thấy lisp chạy khá tốt.

Nhưng để tiện theo dõi thì nên thêm tính năng đánh STT ( text) của các block được chọn bên cạnh block đó luôn thì dễ theo dõi hơn với bản vẽ có nhiều block?

Chân thành cám ơn !

Đánh stt vào bản vẽ?

  • 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 ĐVH ơi. Sao lisp update mà vẫn không thấy ghi text bên cạnh block mà chỉ là dòng lệnh thông báo !

 

Chon Block lam mau:

Chon Text cao do lam mau:

Chon tap hop cac Block va Text cao do...

Select objects: Specify opposite corner: 176 found

 

Select objects: TEXT

Current text style: "Standard" Text height: 0.2000

Specify start point of text or [Justify/Style]: non

Specify height <0.2000>: 0.500000000000000

Specify rotation angle of text <0>:

Enter text: 1

Command: TEXT

Current text style: "Standard" Text height: 0.5000

Specify start point of text or [Justify/Style]: non

Specify height <0.5000>: 0.500000000000000

Specify rotation angle of text <0>:

Enter text: 2

Command: TEXT

Current text style: "Standard" Text height: 0.5000

Specify start point of text or [Justify/Style]: non

Specify height <0.5000>: 0.500000000000000

Specify rotation angle of text <0>:

Enter text: 3

Cám ơn. Chúc mọi người 1 buổi tối vv và xem CPL :D

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
Doan Van Ha    2.676

Bác ĐVH ơi. Sao lisp update mà vẫn không thấy ghi text bên cạnh block mà chỉ là dòng lệnh thông báo !

Có đấy, nh­ưng do bạn không zoom vào để nhìn thôi. Tôi đã chuyển qua màu đỏ cho bạn dễ thấy (link cũ).

Với trình độ của bạn thì bạn dư sức sửa mấy thứ lẻ tẻ đó, nên nếu có muốn thêm thắt gì thì hãy tự làm cho... mọi người đều có việ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
dinhthe265    1

Nhân tiện liên quan đến text e nhờ Mấy bác sửa hộ em cái lisp này để nó không chỉ copy và cộng đến 100 mà lớn hơn nữa! E là gà mới làm quen với lisp nhờ các bác quan tâm giúp đỡ! Links ở phía dướ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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×