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  
tutranvan1988

[Nhờ chỉnh sửa] Lisp tăng chỉ số

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

Em chào các bác.

Em được biết trên diễn đàn đã có list tăng chỉ số.

Ví dụ: C01; C02...

Tuy nhiên trong trường hợp của em bắt đầu là C01-D; em muốn sử dụng list để tạo ra C02-D; C03-D... thì nó lại tăng ký tự cuối cùng là C01-D; C01-E; C01-F.

Em muốn hỏi có bác nào có list để tăng chỉ số trong trường hợp của em không ạ?

Thank cả nhà!

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
phamthanhbinh    3.123

Em chào các bác.

Em được biết trên diễn đàn đã có list tăng chỉ số.

Ví dụ: C01; C02...

Tuy nhiên trong trường hợp của em bắt đầu là C01-D; em muốn sử dụng list để tạo ra C02-D; C03-D... thì nó lại tăng ký tự cuối cùng là C01-D; C01-E; C01-F.

Em muốn hỏi có bác nào có list để tăng chỉ số trong trường hợp của em không ạ?

Thank cả nhà!

Hề hề hề,

Yêu cầu của bạn không khó, nhưng do bạn đã có file lisp thì hãy gửi nó lên , mọi người sẽ chỉnh file lisp đó giùm bạn , đỡ mất công làm lại từ đầu bạn ạ.

hề hề hề...

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
tinya1225    34

Em chào các bác.

Em được biết trên diễn đàn đã có list tăng chỉ số.

Ví dụ: C01; C02...

Tuy nhiên trong trường hợp của em bắt đầu là C01-D; em muốn sử dụng list để tạo ra C02-D; C03-D... thì nó lại tăng ký tự cuối cùng là C01-D; C01-E; C01-F.

Em muốn hỏi có bác nào có list để tăng chỉ số trong trường hợp của em không ạ?

Thank cả nhà!

Lệnh TCOUNT có thể làm đc cái bạn cần rùi mà sao lại phải dùng lisp nữa.

Và chi tiết về lệnh TCOUNT thì bác Hoành đã trình bày rất rõ rùi bạn đọc thì sẽ làm đc.

Chúc thành công.

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

Hề hề hề,

Yêu cầu của bạn không khó, nhưng do bạn đã có file lisp thì hãy gửi nó lên , mọi người sẽ chỉnh file lisp đó giùm bạn , đỡ mất công làm lại từ đầu bạn ạ.

hề hề hề...

Em sử dụng list này ạ.

Em chưa biết cách upload nên dùng tạm cách copy and patse.

Ở phía dưới có anh nói là dùng tcout. Trong trường hợp này không dùng tcout dược đâu ạ.

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=34029
;; free lisp from cadviet.com

;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************


;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
   sty (getvar "textstyle")
   d (tblsearch "style" sty)
   h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
   (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
   n2 (itoa (+ dn (atoi n)))
   i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
   i (strlen c)
   c1 (substr c 1 (- i 1))
   c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
   (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
   (strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
   cn (getstring "\nBegin at <1>: " T)
   dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
   (wtxt cn p)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
)
(princ)
)
;;;============================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
   e (car (entsel "\nSelect template text:"))
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
   (command "copy" e "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entlast))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)    
)
(princ)
)
;;;============================
(defun C:oCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
   e0 (car (entsel "\nSelect attribute block:"))
   e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
   (command "copy" e0 "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entnext (entlast)))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)
   (command "regen")
)
(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
tinya1225    34

Em sử dụng list này ạ.

Em chưa biết cách upload nên dùng tạm cách copy and patse.

Ở phía dưới có anh nói là dùng tcout. Trong trường hợp này không dùng tcout dược đâu ạ.

Bạn đã hiểu về lệnh TCOUNT chưa mà nói là không dùng đc vậy. Bạn copy tất cả những chữ cần đánh số với cùng mẫu C01-D, dùng TCOUNT với chức năng find&replace (search string value gõ 1)hoàn toàn có thể làm được theo yêu cầu của bạ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

@tutranvan1988 : Bài của bạn post sai địa chỉ, code thì chưa cho vào thẻ

, và nhầm lẫn cơ bản giữa [b]List[/b] và [b]Lisp[/b], mình đã sửa lại, hi vọng bạn không phiền và rút kinh nghiệm nhé  :wub:

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
phamthanhbinh    3.123

Em sử dụng list này ạ.

Em chưa biết cách upload nên dùng tạm cách copy and patse.

Ở phía dưới có anh nói là dùng tcout. Trong trường hợp này không dùng tcout dược đâu ạ.

 

Hề hề hề,

Bạn dùng thử cái ni coi ưng ý chưa nhé.


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=34029
;; free lisp from cadviet.com

;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************


;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
   sty (getvar "textstyle")
   d (tblsearch "style" sty)
   h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
   (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
   n2 (itoa (+ dn (atoi n)))
   i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
   i (strlen c)
   c1 (substr c 1 (- i 1))
   c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
   (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
   (strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
   cn (getstring "\nBegin at <1>: " T)
   dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
   (wtxt cn p)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
)
(princ)
)
;;;============================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(command "undo" "be")
(setq
   e (car (entsel "\nSelect template text:"))
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
   k (strlen cn)
   i (getint "\n Nhap so ky tu can giu trong suffix: ")
   cn0 (substr cn 1 (- k i))
   cn1 (substr cn (1+ (- k i)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn0)
   n (vl-string-subst "" c cn0)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
   (command "copy" e "" p1 p2)
   (if (= n "") 
       (setq cn0 (incC cn0))
       (setq cn0 (strcat c (incN (vl-string-subst "" c cn0) dn)))        
   )
   (setq
       dat (entget (entlast))
       dat (subst (cons 1 (strcat cn0 cn1)) (assoc 1 dat) dat)
   )
   (entmod dat)    
)
(command "undo" "e")
(princ)
)
;;;============================
(defun C:oCA( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
   e0 (car (entsel "\nSelect attribute block:"))
   e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
   dn (getint "\nIncrement <1>: ")
   p1 (getpoint "\nBase point:")
   cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
   c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
   n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
   (command "copy" e0 "" p1 p2)
   (if (= n "") 
       (setq cn (incC cn))
       (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
   )
   (setq
       dat (entget (entnext (entlast)))
       dat (subst (cons 1 cn) (assoc 1 dat) dat)
   )
   (entmod dat)
   (command "regen")
)
(princ)
)
;;;============================

Hề hề hề,

Cái ni mình chỉ có sửa bổ sung vào cái lisp của bác SSG nên bạn hãy cám ơn bác ấy nhé.

Khi bạn nhập "Nhap so ky tu can giu trong suffix: " là 0 thì kết quả sẽ y như của bác SSG đã viết.

Trong ví dụ bạn đưa, text mẫu là C01-D thì ở chỗ "Nhap so ky tu can giu trong suffix: " bạn cần nhập là 2. Kết quả sẽ có C02-D, C03-D.... nếu Increament là 1, và kết quả sẽ là C03-D, C05-D nếu increament là 2, ......

Chúc bạn vui,....

  • 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

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  

×