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  
790312

Nhờ sửa lisp đếm block

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

790312    4

Mình tải được lisp đếm block trên diễn đàn nhưng lisp này đếm số lượng rồi tự đông ghi ra text trên cad.Nay mình muốn không muốn ghi ra text mà sẽ hiệ số lượng trên màn hình ngay con trỏ chuột luôn.Thanks.

(defun c:cb ()
(vl-load-com)
(setq p1 (getpoint "\nKhoanh vung chon doi tuong: ")
p2 (getcorner p1)
p3 (getpoint "\nVi tri dat text")
ht (getvar "textsize")
oldos (getvar "osmode"))
(setq name T)
(setvar "osmode" 0)
(while name
(setq name (car (entsel "\nChon loai block can dem: ")))
(while (= name nil)
(setq name (car (entsel "\nChon loai block can dem: ")))
)
(setq ent (entget name))
(command "zoom" p1 p2)
(setq nhomb (ssget "c" p1 p2 (list (assoc 0 ent) (assoc 2 ent)))
noidung (strcat "so den: " (cdr (assoc 2 ent)) " co " (rtos (sslength nhomb) 2 0) " cai")
)
(command "text" p3 "" "" noidung)
(setq p3 (polar p3 (/ (* pi 3) 2) (/ (* ht 5) 3)))
(command "zoom" "p")
(setq dk (getstring "\nBan co muon tiep tuc khong: Co/Khong: <CO>: "))
(if (= (strcase dk) "K") (setq name nil))
(if (or (= (strcase dk) "C") (= dk "")) (setq name T))
)
(setvar "osmode" 15359)
)

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

Mình tải được lisp đếm block trên diễn đàn nhưng lisp này đếm số lượng rồi tự đông ghi ra text trên cad.Nay mình muốn không muốn ghi ra text mà sẽ hiệ số lượng trên màn hình ngay con trỏ chuột luôn.Thanks.

Sửa thế này được không Bạn?

(defun c:cb ()
(vl-load-com)
(setq p1 (getpoint "\nKhoanh vung chon doi tuong: ")
      p2 (getcorner p1)
      ht (getvar "textsize")
      oldos (getvar "osmode"))
(setq name T)
(setvar "osmode" 0)
(while name
 (setq name (car (entsel "\nChon loai block can dem: ")))
 (while (= name nil)
  (setq name (car (entsel "\nChon loai block can dem: "))))
 (setq ent (entget name))
 (command "zoom" p1 p2)
 (setq nhomb (ssget "c" p1 p2 (list (assoc 0 ent) (assoc 2 ent)))
       noidung (strcat "so den: " (cdr (assoc 2 ent)) " co " (rtos (sslength nhomb) 2 0) " cai"))
 (alert noidung)
 (command "zoom" "p")
 (setq dk (getstring "\nBan co muon tiep tuc khong: Co/Khong: <CO>: "))
 (if (= (strcase dk) "K") (setq name nil))
 (if (or (= (strcase dk) "C") (= dk "")) (setq name T)))
(setvar "osmode" 15359))

P/S 790312: "ý mình là nó hiện lên giống dòng KHOANH VÙNG CHỌN ĐỐI TƯỢNG và CHỌN LOẠI BLOCK CẦN ĐẾM ...bạn ah.Dù gì cũng vote bạn 1 cái."

Cái này tôi chưa biết nên chịu!!! Ai biết chỉ giùm 790312.

  • 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
790312    4

ý mình là nó hiện lên giống dòng KHOANH VÙNG CHỌN ĐỐI TƯỢNG và CHỌN LOẠI BLOCK CẦN ĐẾM ...bạn ah.Dù gì cũng vote bạn 1 cá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
Detailing    278

Sửa thế này được không Bạn?

(defun c:cb ()
(vl-load-com)
(setq p1 (getpoint "\nKhoanh vung chon doi tuong: ")
  	p2 (getcorner p1)
  	ht (getvar "textsize")
  	oldos (getvar "osmode"))
(setq name T)
(setvar "osmode" 0)
(while name
 (setq name (car (entsel "\nChon loai block can dem: ")))
 (while (= name nil)
  (setq name (car (entsel "\nChon loai block can dem: "))))
 (setq ent (entget name))
 (command "zoom" p1 p2)
 (setq nhomb (ssget "c" p1 p2 (list (assoc 0 ent) (assoc 2 ent)))
       noidung (strcat "so den: " (cdr (assoc 2 ent)) " co " (rtos (sslength nhomb) 2 0) " cai"))
 (alert noidung)
 (command "zoom" "p")
 (setq dk (getstring "\nBan co muon tiep tuc khong: Co/Khong: <CO>: "))
 (if (= (strcase dk) "K") (setq name nil))
 (if (or (= (strcase dk) "C") (= dk "")) (setq name T)))
(setvar "osmode" 15359))

P/S 790312: "ý mình là nó hiện lên giống dòng KHOANH VÙNG CHỌN ĐỐI TƯỢNG và CHỌN LOẠI BLOCK CẦN ĐẾM ...bạn ah.Dù gì cũng vote bạn 1 cái."

Cái này tôi chưa biết nên chịu!!! Ai biết chỉ giùm 790312.

Nếu ý bạn đó muốn hiện trên command line thì dùng

(prompt noidung)

(getstring)

thay cho

(alert noidung)

  • 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
790312    4

Nếu ý bạn đó muốn hiện trên command line thì dùng

(prompt noidung)

(setq tmp(getstring))

thay cho

(alert noidung)

Được rồi bạn ah nhưng phía sau có cái ô màu xanh đánh chữ vào được vậy bỏ ô này bằng cách nào?

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

Nếu ý bạn đó muốn hiện trên command line thì dùng

(prompt noidung)

(getstring)

thay cho

(alert noidung)

Không phải đâu! Hiện trên màn hình và di chuyển theo sự di chuyển của con chuột cơ!

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
Detailing    278

Không phải đâu! Hiện trên màn hình và di chuyển theo sự di chuyển của con chuột cơ!

Mình edit lại code của bạn, bạn test thử có gì chỉnh lại dùm nhe

(defun c:cb ()
 (vl-load-com)
 (setq	p1	(getpoint "\nKhoanh vung chon doi tuong: ")
p2	(getcorner p1)
ht	(getvar "textsize")
oldos (getvar "osmode")
 )
 (setq name T)
 (setvar "osmode" 0)
 (while name
(setq name (car (entsel "\nChon loai block can dem: ")))
(while (= name nil)
 	(setq name (car (entsel "\nChon loai block can dem: ")))
)
(setq ent (entget name))
(command "zoom" p1 p2)
(setq nhomb  	(ssget "c" p1 p2 (list (assoc 0 ent) (assoc 2 ent)))
 	noidung (strcat "so den: "
 			(cdr (assoc 2 ent))
 			" co "
 			(rtos (sslength nhomb) 2 0)
 			" cai"
 		)
)
(prompt noidung)
(getstring)
(command "zoom" "p")
(setq
 	dk (getstring "\nBan co muon tiep tuc khong: Co/Khong: <CO>: ")
)
(if	(= (strcase dk) "K")
 	(setq name nil)
)
(if	(or (= (strcase dk) "C") (= dk ""))
 	(setq name T)
)
 )
 (setvar "osmode" 15359)
)

 

p/s: bạn phải mở Dynamic Input nó mới hiện lên ngay con trỏ chuột

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

Mình edit lại code của bạn, bạn test thử có gì chỉnh lại dùm nhe

p/s: bạn phải mở Dynamic Input nó mới hiện lên ngay con trỏ chuột

Cái này được rồi, nhưng bỏ dòng (prompt noidung) đi và thay (getstring) bởi (getstring noidung) thì ngắn hơn được 1 chút.

P/S 790312: cái này đáp ứng y/c của bạn, nhưng cũng mất 1 động tác Enter đấ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
Detailing    278

Cái này được rồi, nhưng bỏ dòng (prompt noidung) đi và thay (getstring) bởi (getstring noidung) thì ngắn hơn được 1 chút.

P/S 790312: cái này đáp ứng y/c của bạn, nhưng cũng mất 1 động tác Enter đấy!

Hì hì, alert thì mình cũng phải enter mà, chỉ trừ prompt và princ nhưng sau đó lại có command zoom nên nó sẽ chạy mất câu thông báo :rolleyes:

 

2 bạn xem bài số 5 rồi giúp mình với.

Vậy bạn muốn làm sao để AutoCAD hiểu được là bạn muốn tiếp tục công việc nếu ko bấm enter? <_< nếu bạn chỉ muốn dừng 1 khoảng thời gian cố định thì dùng 1 cái while (với số lần lặp cho trước.)

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
t031285    1

Mình cũng sưu tầm được lisp đếm block,mong các bác sửa cho nó hiện số block đếm được lên màn hình giống lisp ở trên.Thanks.

(Defun c:bb ( ) 
(prompt "\nChon BLOCK mau.")
(setq DT (car (entsel)))
(setq DT (entget DT))
(setq STNAME (cdr (assoc 2 DT)))
(Princ "\nHay chon vung :")
(setq SS (ssget (list (cons 0 "insert")
(cons 2 STNAME)
)
) 
)
(if (Null ss)
(princ "\nKhong tim thay doi tuong nao")
)
(IF (/= NIL SS) (PROGN
(setq Sl (SSLength SS))
(princ (strcat "\nTim thay: <" (itoa sl) "> doi tuong la BLOCK co ten: <" STNAME ">"))
)
)
(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
Tue_NV    3.841

Mình cũng sưu tầm được lisp đếm block,mong các bác sửa cho nó hiện số block đếm được lên màn hình giống lisp ở trên.Thanks.

(Defun c:bb ( ) 
(prompt "\nChon BLOCK mau.")
(setq DT (car (entsel)))
(setq DT (entget DT))
(setq STNAME (cdr (assoc 2 DT)))
(Princ "\nHay chon vung :")
(setq SS (ssget (list (cons 0 "insert")
(cons 2 STNAME)
)
) 
)
(if (Null ss)
(princ "\nKhong tim thay doi tuong nao")
)
(IF (/= NIL SS) (PROGN
(setq Sl (SSLength SS))
(princ (strcat "\nTim thay: <" (itoa sl) "> doi tuong la BLOCK co ten: <" STNAME ">"))
)
)
(princ)
) 

Sửa lại cho bạn :

(Defun c:bb (/ dynm dynp DT STNAME SS SL) 
(setq dynm (getvar "dynmode"))
(setq dynp (getvar "dynprompt"))
(mapcar 'setvar '("dynmode" "dynprompt") '(1 1))
(prompt "\nChon BLOCK mau.")
(setq DT (car (entsel)))
(setq DT (entget DT))
(setq STNAME (cdr (assoc 2 DT)))
(Princ "\nHay chon vung :")
(setq SS (ssget (list (cons 0 "insert")
(cons 2 STNAME)
)
) 
)
(if (Null ss)
(princ "\nKhong tim thay doi tuong nao")
)
(IF (/= NIL SS) (PROGN
(setq Sl (SSLength SS))
(getstring (strcat "\nTim thay: <" (itoa sl) "> doi tuong la BLOCK co ten: <" STNAME ">"))
)
)
(princ)
(mapcar 'setvar '("dynmode" "dynprompt") ( list dynm dynp))
)

 

.........

p/s: bạn phải mở Dynamic Input nó mới hiện lên ngay con trỏ chuột

Bạn Nên set và trả lại biến hệ thống DYNMODE và DYNPROMPT trong Lisp

  • 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
Detailing    278

Bạn Nên set và trả lại biến hệ thống DYNMODE và DYNPROMPT trong Lisp

 

Thanks Tue_NV, cái đó là p/s cho bạn Doan Van Ha vì mình nghĩ có lẽ bạn đó chưa mở lên còn chủ topic có mở rồi (đọc yêu cầu là thấy ngay)

Do mình ko thích set lại các biến hệ thống về giao diện (ảnh hưởng đến thói quen của người dùng) có ng khi đánh lệnh thường nhìn vào command line nhưng nếu set các biến như TueNV đã làm thì nếu user cacel command khi chọn Block biến đó sẽ ko dc trả lại như cũ.

Vậy nếu muốn mình nên set trước khi show thông báo và sau đó trả lại như cũ thì có lẽ tốt hơn.

 

 

.....
(mapcar 'setvar '("dynmode" "dynprompt") '(1 1))
(getstring (strcat "\nTim thay: <" (itoa sl) "> doi tuong la BLOCK co ten: <" STNAME ">"))
(mapcar 'setvar '("dynmode" "dynprompt") ( list dynm dynp))
.....

 

 

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

Thanks Tue_NV, cái đó là p/s cho bạn Doan Van Ha vì mình nghĩ có lẽ bạn đó chưa mở lên còn chủ topic có mở rồi (đọc yêu cầu là thấy ngay)

Do mình ko thích set lại các biến hệ thống về giao diện (ảnh hưởng đến thói quen của người dùng) có ng khi đánh lệnh thường nhìn vào command line nhưng nếu set các biến như TueNV đã làm thì nếu user cacel command khi chọn Block biến đó sẽ ko dc trả lại như cũ.

Vậy nếu muốn mình nên set trước khi show thông báo và sau đó trả lại như cũ thì có lẽ tốt hơn.

 

 

.....
(mapcar 'setvar '("dynmode" "dynprompt") '(1 1))
(getstring (strcat "\nTim thay: <" (itoa sl) "> doi tuong la BLOCK co ten: <" STNAME ">"))
(mapcar 'setvar '("dynmode" "dynprompt") ( list dynm dynp))
.....

Nếu nói tới cùng thì ngay cả cách của Detailing cũng chưa triệt để, mà nó chỉ "ít nguy cơ hơn" Tue_NV vì nó "nằm sát" dòng "getstring..." mà thôi. Bởi nếu khi nó xuất hiện dòng thông báo mà ta bấm "esc" thì nó cũng không trở về biến cũ. Cần phải dùng thêm thằng "error" nữa mới OK tuyệt đối được.

Nhưng thiết nghĩ, ở đây chỉ giải quyết 1 y/c là hiện thông báo theo con chuột thì như thế là được rồi các bạn ạ.

Nói thêm cho vui: để 1 lsp hoàn chỉnh tuyệt đối là hơi bị mệt. Đôi khi chúng ta vẫn thường viết nhanh để đạt 1 mục tiêu nào đó mà không quá chi li về các vấn đề liên quan khác. Chẳng hạn, chỉ mỗi y/c nhập số lần copy, chúng ta vẫn thường viết (setq sl (getint "Nhap so lan copy: ")), mà chúng ta ít để ý khi người dùng nhập "-3" thì sẽ thế nào. Do đó, bỏ quên (initget) trong trường hợp này là thường, trên CADViet có muôn vàn.

Chúc mọi người 1 ngày làm việc vui vẻ!

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
t031285    1

Sửa lại cho bạn :

(Defun c:bb (/ dynm dynp DT STNAME SS SL) 
(setq dynm (getvar "dynmode"))
(setq dynp (getvar "dynprompt"))
(mapcar 'setvar '("dynmode" "dynprompt") '(1 1))
(prompt "\nChon BLOCK mau.")
(setq DT (car (entsel)))
(setq DT (entget DT))
(setq STNAME (cdr (assoc 2 DT)))
(Princ "\nHay chon vung :")
(setq SS (ssget (list (cons 0 "insert")
(cons 2 STNAME)
)
) 
)
(if (Null ss)
(princ "\nKhong tim thay doi tuong nao")
)
(IF (/= NIL SS) (PROGN
(setq Sl (SSLength SS))
(getstring (strcat "\nTim thay: <" (itoa sl) "> doi tuong la BLOCK co ten: <" STNAME ">"))
)
)
(princ)
(mapcar 'setvar '("dynmode" "dynprompt") ( list dynm dynp))
)

 

 

Bạn Nên set và trả lại biến hệ thống DYNMODE và DYNPROMPT trong Lisp

Nhờ bác chỉnh sao cho CHỌN BLOCK MẪU và HÃY CHỌN VÙNG hiện lên màn hình luôn giùm e với.Thanks.

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
ketxu    2.649

<_< nếu bạn chỉ muốn dừng 1 khoảng thời gian cố định thì dùng 1 cái while (với số lần lặp cho trước.)

Thân!

Dùng Delay cũng được 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
Tue_NV    3.841

Nhờ bác chỉnh sao cho CHỌN BLOCK MẪU và HÃY CHỌN VÙNG hiện lên màn hình luôn giùm e với.Thanks.

Bạn thay dòng này :

(setq DT (car (entsel)))

thành dòng :

(setq DT (car (entsel "\nChon BLOCK mau.")))

 

Còn "HÃY CHỌN VÙNG" thì đó chính là select object rồi. Thay dòng select object đó thì bó tay vì đó là dòng nhắc của hàm ssget

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
ketxu    2.649

Nhờ bác chỉnh sao cho CHỌN BLOCK MẪU và HÃY CHỌN VÙNG hiện lên màn hình luôn giùm e với.Thanks.

Cá nhân mình thấy việc này khá vô bổ t031285 ạ :rolleyes:

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

Xin hỏi Tue_NV: Có cách nào mình làm được như sau không?

- Chọn block mẫu

- Chọn vùng chứa block: vùng này là 1 polyline khép kín chứa block cần đếm.Chỉ cần pick chọn PL là đếm được số block trong vùng kín.

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
t031285    1

Cá nhân mình thấy việc này khá vô bổ t031285 ạ :rolleyes:

Thay vì hiện VÙNG CHỌN thì nó hiện SELECT OBJECTS nhìn thấy chữ này dễ lộn chọn lại chọn đối tượng nên mình muốn hiện VÙNG CHỌN cho khỏi lộn thôi bạn ah.

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
Detailing    278

Dùng Delay cũng được vậy ^^

Thanks Ketxu nhưng ko biết lisp có hàm này ko vì ít khi dùng lisp lắm. Nếu dc thì cho mình 1 cái sample nha.

Thanks again!

 

 

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

Thanks Ketxu nhưng ko biết lisp có hàm này ko vì ít khi dùng lisp lắm. Nếu dc thì cho mình 1 cái sample nha.

Thanks again!

Sample:

(command "delay" 1) t­ương đương tạm dừng 1/1000 giây.

(command "delay" 1000) t­ương đương tạm dừng 1000/1000 = 1 giây.

  • 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
Detailing    278

Sample:

(command "delay" 1) t­ương đương tạm dừng 1/1000 giây.

(command "delay" 1000) t­ương đương tạm dừng 1000/1000 = 1 giây.

Thanks bạn!

Nhưng nếu là command thì ko dc vì nó sẽ ko hiện prompt, đã check lại là while cũng ko dc luôn nên chỉ còn cách enter trong (getstring) như bài viết của bạn ở trê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
ketxu    2.649

Minh họa dùng while để delay với hướng đi khác mọi người 1 chút :

(Defun c:bb (/ dynm dynp DT STNAME SS SL)
(ST:Ui-DelayText "Chän Block mÉu :" 60)
(setq DT (entget (car (entsel))))
(setq STNAME (cdr (assoc 2 DT)))
(Princ "\nHay chon vung :")
(ST:Ui-DelayText "Chän vïng chøa block :" 60)
(setq SS (ssget (list (cons 0 "insert")(cons 2 STNAME))))
(IF (/= NIL SS)
(ST:Ui-DelayText (strcat "Sè l­îng block " STNAME " lµ :" (rtos (SSLength SS) 2 0)) 120)
(ST:Ui-DelayText (strcat "RÊt tiÕc, vïng b¹n chän kh«ng cã ®èi t­îng Block " STNAME " nµo !") 80)
)
(princ)
)

(defun ST:Ui-DelayText (msg count / data txtObj wtxt_l) ;@Son Tung
(defun wtxt_l(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf) (cons 1 txt) (cons 10 p))))
(setq txtObj (vlax-ename->vla-object(wtxt_l msg '(0 0 0))) i 0)
(while (< i count)
(setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr) i (1+ i))
(cond ((= g1 5)
(vla-put-visible  txtObj :vlax-true)
(setq data g2)
(setq data (trans data 1 0))
(vla-put-InsertionPoint txtObj (vlax-3D-point data))
)  
)
)
(vla-delete txtObj)
)

  • Vote tăng 4

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  

×