Đến nội dung


Hình ảnh
- - - - -

Lisp đánh số thứ tự bản vẽ tự động?


  • Please log in to reply
60 replies to this topic

#21 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 05 November 2010 - 09:52 PM

Mình đã tìm rồi.nhưng vẫn không thấy nếu ban 'phamthanhbinh' biết thì chỉ dùm mình cái dường dẫn.Cám on bạn Bình nhiều.

antony có thể sử dụng Lisp shbv của Tue_NV ở đây :
Lisp shbv - Bài viết số 464
  • 0

#22 anhvuday

anhvuday

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 23 December 2010 - 02:47 PM

Rất cảm ơn bạn nhưng nếu bản vẽ chỉ có 1 cột thì nó không hiểu. Mong bạn sửa giúp lỗi này.

tại sao mình nhấp vào đường link mà không thấy gì hết vậy, mong bạn cho lại đường link mới
  • 0

#23 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 December 2010 - 03:17 PM

Chắc ý bác ấy là lisp này,bạn dùng thử xem sao rồi lại càm men tiếp nhé :undecided:

;; free lisp from cadviet.com

;; copyright by Tue_NV
(defun c:shbv(/ dau tong po po1 ent i pre cao)
(prompt "\n Danh so hieu ban ve dang n/m ")
(setvar "cmdecho" 0)

(command "style" "CADVIET" "Vhelven.TTF" "2" "1" "0" "n" "n")
(if (not caoo) (setq caoo 2))
(setq cao (getreal (strcat "\n Nhap chieu cao chu :")))
(if (not cao) (setq cao caoo) (setq caoo cao))

(setq pre "< KC, CN KT>: ")
(wtxt pre '(0 0 0))
(command "ddedit" (entlast) "")
(setq pre (cdr(assoc 1 (entget(entlast)))))
(entdel (entlast))
(setq dau (getint "\n Danh so bat dau (n):"))
(setq tong (getint "\n Danh so tong (m):") i 1)

(setq po (getpoint
(strcat "\n Cho diem chen cua so: " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" (itoa tong))))
(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" (itoa tong)) po)

(Repeat (- tong dau)
(setq po1 (getpoint po
(strcat "\n Cho diem chen cua so: " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))))

(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#24 kiwi

kiwi

    biết zoom

  • Members
  • Pip
  • 18 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 January 2011 - 10:47 AM

Bác ơi , cái này cho kết quả (vd) 01/5. Bác có thể sửa lại chút xíu thành 01/05 được không ạ (05: tổng số bản vẽ). Cảm ơn bác nhiều
  • 0

#25 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 January 2011 - 11:28 PM

OK, mình update giúp bạn đây, hy vọng bạn vừa ý
;; free lisp from cadviet.com : ketxu update from @Tue_NV
(defun c:shbv(/ dau tong po po1 ent i pre sotong)
(prompt "\n Danh so hieu ban ve dang n/m ")
(setvar "cmdecho" 0)
(setq pre "< KC, CN KT>: ")
(wtxt pre '(0 0 0))
(command "ddedit" (entlast) "")
(setq pre (cdr(assoc 1 (entget(entlast)))))
;(setq pre (strcat pre ": "))
(entdel (entlast))
(setq dau (getint "\n Danh so bat dau (n):"))
(setq tong (getint "\n Danh so tong (m):") i 1)
(if (< tong 10) (setq sotong (strcat "0" (itoa tong))) (setq sotong (itoa tong)))
(setq po (getpoint
(strcat "\n Cho diem chen cua so: " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong)))
(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong) po)

(Repeat (- tong dau)
(setq po1 (getpoint po
(strcat "\n Cho diem chen cua so: " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)))

(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt(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))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))

  • 3

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#26 kiwi

kiwi

    biết zoom

  • Members
  • Pip
  • 18 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 January 2011 - 07:40 AM

Cảm ơn bác nhiều !!!^^
  • 0

#27 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 16 July 2011 - 11:46 AM

Bạn đã đọc kỹ chưa?
Tue_NV nói là cách thức của nó hoạt động tương tự như lệnh array
Hàng từ trái -> phải : khoảng cách hàng >0
Hàng từ phải -> trái : khoảng cách hàng < 0

Cột từ dưới lên trên : khoảng cách cột >0
Cột từ trên xuống dưới : khoảng cách cột <0

Mong là bạn hiểu.
Tue_NV upload file Lisp này có chỉnh sửa theo ý bạn
Tên lệnh dsbv
http://www.cadviet.c...iles/dsbv_1.vlx

Lisp này rất hay. Lệnh:
Command: dsbv
Ban ve dau tien la ban ve so :1
Cho diem chen cua ban ve dau tien :
So hang ban ve :2
Nhap khoang cach hang cua ban ve :-56
So cot ban ve :2
Nhap khoang cach cot cua ban ve :76
Bác có thể sửa lisp trên định dạng theo kiểu 01/05:
  • 0

#28 danhgapro

danhgapro

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 18 July 2011 - 04:33 PM

OK, mình update giúp bạn đây, hy vọng bạn vừa ý

;; free lisp from cadviet.com : ketxu update from @Tue_NV
(defun c:shbv(/ dau tong po po1 ent i pre sotong)
(prompt "\n Danh so hieu ban ve dang n/m ")
(setvar "cmdecho" 0)
(setq pre "< KC, CN KT>: ")
(wtxt pre '(0 0 0))
(command "ddedit" (entlast) "")
(setq pre (cdr(assoc 1 (entget(entlast)))))
;(setq pre (strcat pre ": "))
(entdel (entlast))
(setq dau (getint "\n Danh so bat dau (n):"))
(setq tong (getint "\n Danh so tong (m):") i 1)
(if (< tong 10) (setq sotong (strcat "0" (itoa tong))) (setq sotong (itoa tong)))
(setq po (getpoint
(strcat "\n Cho diem chen cua so: " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong)))
(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong) po)

(Repeat (- tong dau)
(setq po1 (getpoint po
(strcat "\n Cho diem chen cua so: " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)))

(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt(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))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))



Lisp rất hay, nhưng đến phần " cho điểm chèn của số" mình muốn click thay số vào text có sẵn được không??.Nhờ bác sửa dùm. Thanks cả nhà.
  • 0

#29 danhgapro

danhgapro

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 26 July 2011 - 03:56 PM

Lâu rồi mà không thấy ai trả lời dùm với.
  • 0

#30 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 26 July 2011 - 05:02 PM

Lâu rồi mà không thấy ai trả lời dùm với.

Hề hề hề,
Không hiểu cái yêu cầu của bạn thì làm sao mà trả lời??? Hãy cho một ví dụ cụ thể về cái text sẵn có ây nhé.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#31 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 26 July 2011 - 07:26 PM

Hề hề hề,
Không hiểu cái yêu cầu của bạn thì làm sao mà trả lời??? Hãy cho một ví dụ cụ thể về cái text sẵn có ây nhé.

Theo mình ý bạn ấy là: trước khi đánh số chọn trước vị trí text sẵn ở tại vị trí muốn đánh số để text không bị nhảy.Lisp đang dùng khi chọn vị trí của text nếu điểm chèn không chuẩn sẽ bị nhảy không đúng vị trí?
  • 0

#32 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 27 July 2011 - 12:45 AM

Theo mình ý bạn ấy là: trước khi đánh số chọn trước vị trí text sẵn ở tại vị trí muốn đánh số để text không bị nhảy.Lisp đang dùng khi chọn vị trí của text nếu điểm chèn không chuẩn sẽ bị nhảy không đúng vị trí?

Hề hề hề,
Phải chăng bạn ấy muốn cái như thế này:

;; free lisp from cadviet.com : ketxu update from @Tue_NV
(defun c:shbv(/ dau tong po po1 ent i pre sotong en en1)
(command "undo" "be")
(prompt "\n Danh so hieu ban ve dang n/m ")
(setvar "cmdecho" 0)
(setq pre "< KC, CN KT>: ")
(wtxt pre '(0 0 0))
(command "ddedit" (entlast) "")
(setq pre (cdr(assoc 1 (entget(entlast)))))
;(setq pre (strcat pre ": "))
(entdel (entlast))
(setq dau (getint "\n Danh so bat dau (n):"))
(setq tong (getint "\n Danh so tong (m):") i 1)
(if (< tong 10) (setq sotong (strcat "0" (itoa tong))) (setq sotong (itoa tong)))
(setq po (cdr (assoc 11 (entget (car (setq en (entsel
(strcat "\n Hay chon text can thay the boi " pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong))))))))
;;;;(getpoint (strcat "\n Cho diem chen cua so: " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong)))
(command "erase" en "")
(wtxt (strcat pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong) po)

(Repeat (- tong dau)
(setq po1 (cdr (assoc 11 (entget (car (setq en1 (entsel
(strcat "\n Hay chon text can thay the boi " pre (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong))))))))
;;;(getpoint po (strcat "\n Cho diem chen cua so: " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)))
(command "erase" en1 "")
(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat pre (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(command "undo" "e")
(princ)
)
;
(defun wtxt(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))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))


@Bác Tue_NV và Ketxu: Mạn phép sửa lại tí chút cái lisp của các bác cái chổ :
(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong) po)
Có nhẽ phải là:
(wtxt (strcat pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong) po)
mới đúng ạ.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#33 oizdoi_oi

oizdoi_oi

    biết dimlinear

  • Members
  • PipPipPipPipPip
  • 306 Bài viết
Điểm đánh giá: 452 (tốt)

Đã gửi 27 July 2011 - 10:03 AM

bạn cho mình hỏi? có đánh được stt với block ATT không
vd mình có khung bv thế này
http://www.cadviet.c...h_so_thu_tu.dwg
ban danh' so tt jup minh` nhe'
tức là làm sao để bạn thay thế được số kt (text ATT)thành từ kt-01 đến kt-10....vv :blink:
  • 0
KTS không bao giờ chết đói...mà chỉ đói đến lúc chết!

#34 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 27 July 2011 - 10:21 AM

bạn cho mình hỏi? có đánh được stt với block ATT không
vd mình có khung bv thế này
http://www.cadviet.c...h_so_thu_tu.dwg
ban danh' so tt jup minh` nhe'
tức là làm sao để bạn thay thế được số kt (text ATT)thành từ kt-01 đến kt-10....vv :blink:

Bạn nên tham khảo thêm hàm attout, attin. Dùng hàm attout để xuất các thuộc tính ra file txt, chỉnh sửa các thuộc tính trong file txt này. Xong, Dùng hàm attin để cập nhập lại giá trị thuộc tính mình muốn chỉnh sửa. Như vậy, bản vẽ có khung tên là 1 block có thuộc tính sẽ thuận lợi chỉnh sửa hơn nhiều.
Chúc bạn thành công.
  • 0

#35 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 July 2011 - 10:36 AM

bạn cho mình hỏi? có đánh được stt với block ATT không
vd mình có khung bv thế này
http://www.cadviet.c...h_so_thu_tu.dwg
ban danh' so tt jup minh` nhe'
tức là làm sao để bạn thay thế được số kt (text ATT)thành từ kt-01 đến kt-10....vv :blink:

Bạn ngó qua đây xem sao
Block Order
Phiên bản đầy đủ không còn (chắc do tiêu đề không rõ ràng) nhưng vẫn còn cái backup ^^
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#36 danhgapro

danhgapro

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 July 2011 - 03:15 PM

Hề hề hề,
Phải chăng bạn ấy muốn cái như thế này:


;; free lisp from cadviet.com : ketxu update from @Tue_NV
(defun c:shbv(/ dau tong po po1 ent i pre sotong en en1)
(command "undo" "be")
(prompt "\n Danh so hieu ban ve dang n/m ")
(setvar "cmdecho" 0)
(setq pre "< KC, CN KT>: ")
(wtxt pre '(0 0 0))
(command "ddedit" (entlast) "")
(setq pre (cdr(assoc 1 (entget(entlast)))))
;(setq pre (strcat pre ": "))
(entdel (entlast))
(setq dau (getint "\n Danh so bat dau (n):"))
(setq tong (getint "\n Danh so tong (m):") i 1)
(if (< tong 10) (setq sotong (strcat "0" (itoa tong))) (setq sotong (itoa tong)))
(setq po (cdr (assoc 11 (entget (car (setq en (entsel
(strcat "\n Hay chon text can thay the boi " pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong))))))))
;;;;(getpoint (strcat "\n Cho diem chen cua so: " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong)))
(command "erase" en "")
(wtxt (strcat pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong) po)

(Repeat (- tong dau)
(setq po1 (cdr (assoc 11 (entget (car (setq en1 (entsel
(strcat "\n Hay chon text can thay the boi " pre (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong))))))))
;;;(getpoint po (strcat "\n Cho diem chen cua so: " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)))
(command "erase" en1 "")
(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat pre (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(command "undo" "e")
(princ)
)
;
(defun wtxt(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))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))


@Bác Tue_NV và Ketxu: Mạn phép sửa lại tí chút cái lisp của các bác cái chổ :
(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong) po)
Có nhẽ phải là:
(wtxt (strcat pre (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" sotong) po)
mới đúng ạ.



Rất cảm ơn 2 bạn đã hiểu đúng ý mình :D.
Không biết có phải tại máy mình không???, khi kick vào text có sẵn thì text mới bị nhảy lung tung và dồn lại 1 cục...
Nhờ bạn kiểm tra lại dùm.
Cảm ơn nhiều nhiều.
  • 0

#37 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 28 July 2011 - 04:09 PM

Em có lisp này để đánh số bản vẽ có chứa block ATT

(defun c:dsbv (/ ans ins lst blkName tagName ent);Block Order
;; By : Gia_Bach, www.CadViet.com ;;
(vl-load-com)
(while (not (and
(setq ent (car (nentsel "\n Chon thuoc tinh can danh so: ")))
(if ent (eq (cdr (assoc 0 (entget ent))) "ATTRIB") ) ) )
(princ "\n Ban chon nham roi! ") )
(setq blkName (cdr (assoc 2 (entget (cdr (assoc 330 (entget ent))))))
tagName (cdr (assoc 2 (entget ent))) )

(initget 1 "Yes No")
(setq x (getkword "\nBan co muon nhap Tien to ? (Yes or No) "))
(if (= x "Yes")
(progn
(or prefix (setq prefix "KC-"))
(setq ans (getstring t (strcat "\n Nhap tien to <<"prefix ">> :")))
(if (/= ans "")(setq prefix ans)) )
(setq prefix ""))

(or stt (setq stt 1))
(initget 6)
(setq ans (getint (strcat "\n Nhap so bat dau <<"(itoa stt) ">> :")))
(if ans (setq stt ans))
(if (> stt 9)
(setq str (strcat prefix (itoa stt)))
(setq str (strcat prefix "0" (itoa stt))) )

(princ "\nChon Khung ten can danh so thu tu :")
(if (ssget(list (cons 0 "INSERT")(cons 66 1)(cons 2 blkName)))
(progn
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq ins (vlax-safearray->list (variant-value (vla-get-InsertionPoint e)))
lst (cons (list e ins)lst)) )
(setq lst (vl-sort lst '(lambda (x y) (or (> (cadr (cadr x)) (cadr (cadr y)))
(and (< (car (cadr x)) (car (cadr y)))
(= (cadr (cadr x)) (cadr (cadr y))) ) ) ) ))
(foreach e (append (mapcar 'car lst) )
(foreach Att (vlax-invoke e 'GetAttributes)
(if (= (vla-get-TagString att) tagName)
(vla-put-TextString att str) ))
(setq stt (+ 1 stt))
(if (> stt 9)
(setq str (strcat prefix (itoa stt)))
(setq str (strcat prefix "0" (itoa stt))) ) ) ) )
(princ))
Giờ em muốn hiện số block được chọn thì làm như thế nào ?
Em thêm đoạn :
(alert(strcat "Tong so doi tuong Block la :" stt))
vào giữa đoạn:
(setq str (strcat prefix (itoa stt)))
(alert(strcat "Tong so doi tuong Block la :" stt))
(setq str (strcat prefix "0" (itoa stt))) ) ) ) )
Không thấy kết quả ?
Mong các bác chỉ giúp.
Hoặc có thể thêm đoạn mã để lấy ra số đối tượng ATT được chọn ?
  • 1

#38 oizdoi_oi

oizdoi_oi

    biết dimlinear

  • Members
  • PipPipPipPipPip
  • 306 Bài viết
Điểm đánh giá: 452 (tốt)

Đã gửi 28 July 2011 - 05:00 PM

Bạn ngó qua đây xem sao
Block Order
Phiên bản đầy đủ không còn (chắc do tiêu đề không rõ ràng) nhưng vẫn còn cái backup ^^

cám ơn các bạn
mình đã có câu trả lời
rất tuyệt vời khi có lít này
bay giờ đánh tt bản vẽ blok ATT, trong vài giây rồi he he :rolleyes:
  • 0
KTS không bao giờ chết đói...mà chỉ đói đến lúc chết!

#39 danhgapro

danhgapro

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 29 July 2011 - 05:18 PM

cám ơn các bạn
mình đã có câu trả lời
rất tuyệt vời khi có lít này
bay giờ đánh tt bản vẽ blok ATT, trong vài giây rồi he he :rolleyes:

Block ATT là thế nào vậy bạn?? . Mù tịt về cái này..... hic
  • 0

#40 dovananh.xd

dovananh.xd

    biết lệnh offset

  • Members
  • PipPipPip
  • 174 Bài viết
Điểm đánh giá: 25 (tàm tạm)

Đã gửi 21 March 2012 - 02:23 PM

OK, mình update giúp bạn đây, hy vọng bạn vừa ý

;; free lisp from cadviet.com : ketxu update from @Tue_NV(defun c:shbv(/ dau tong po po1 ent i pre sotong)(prompt "\n Danh so hieu ban ve dang n/m ")(setvar "cmdecho" 0)(setq pre "< KC, CN KT>: ")(wtxt pre '(0 0 0))(command "ddedit" (entlast) "") (setq pre (cdr(assoc 1 (entget(entlast)))));(setq pre (strcat pre ": "))(entdel (entlast))(setq dau (getint "\n Danh so bat dau (n):"))(setq tong (getint "\n Danh so tong (m):") i 1)(if (< tong 10) (setq sotong (strcat "0" (itoa tong))) (setq sotong (itoa tong))) (setq po (getpoint (strcat "\n Cho diem chen cua so: " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong)))(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" sotong) po)(Repeat (- tong dau)(setq po1 (getpoint po (strcat "\n Cho diem chen cua so: " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)))(command "copy" "L" "" po po1) (setq ent (entget(entlast)))(setq ent (subst (cons 1 (strcat (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" sotong)) (assoc 1 ent) ent))(entmod ent)(setq i (1+ i))(setq po po1))(princ));(defun wtxt(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))(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p) (cons 1 txt) (cons 10 p))))

Lisp này hay rồi nhưng nếu cách thức hoạt động dạng array như lisp dsbv của bác Tue_VN thì hay quá.
Mong các pro thêm phần này vào nữa.
P/S: phần số thì thay đổi theo cấp số cộng, còn phần chữ thì cố định, và tùy ý người sử dụng chọn. Vd: abc-01 hoặc xyz-01
  • 0