[Nhờ giúp đỡ] lisp copy đối tượng số thứ tự tăng dần với 3 giá trị attribute

[nhatmufc 0]

Em xin chào các anh/chị

Em có một block với 3 giá trị attribute cần tăng số thứ tự. Em xin nhờ các anh chị viết giúp em một lisp khi copy sẽ tăng các số thự tự có trong block như hình em đính kèm ạ

Em xin cảm ơn các anh/chị nhiều!

 

 

Sample.dwg

[ketxu 2.984]

Rồi làm sao để nó biết mà k tăng thằng TBC bạn :D

[Doan Van Ha 3.192]

10 phút trước, ketxu đã nói:

Rồi làm sao để nó biết mà k tăng thằng TBC bạn :D

Ủa, dễ mà. Quản lý tag của nó thôi.

[amateurday 15]

24 phút trước, ketxu đã nói:

Rồi làm sao để nó biết mà k tăng thằng TBC bạn :D

Hề hề, cao thủ mà hỏi thế này thì không ổn nghen.

[nhatmufc 0]

1 giờ} trướ}c, ketxu đã nói:

Rồi làm sao để nó biết mà k tăng thằng TBC bạn :D

Nếu làm lisp theo kiểu nhận diện tên tag thì mới tăng số thứ tự liệu có được không anh. Em cũng không rành về lisp lắm ạ ^^

[nhatmufc 0]

1 giờ} trướ}c, Doan Van Ha đã nói:

Ủa, dễ mà. Quản lý tag của nó thôi.

Bác có thể giúp em con lisp được không ạ. Em cảm ơn bác nhiều ạ

[cuongtk2 347]

Bài này là bài nhận dạng số trong text rồi, cứ tìm số phía sau ra trước.

[Nguyễn Hà Huy 31]

Lisp của bác @Duong Nhat Duy làm được nhé, lệnh STT. Xem video để ở dưới xem đúng ý bạn ko

Animation.rar

[tannguyen291 135]

2 giờ trước, amateurday đã nói:

Hề hề, cao thủ mà hỏi thế này thì không ổn nghen.

Vẫn có thể tăng kiểu a -> b -> c mà nhỉ. nhiều lúc mình vẫn cần mà. 

mình nghĩ nên dùng thêm dialog để chọn những att muốn tăng dần

https://www.lee-mac.com/listbox.html

[ketxu 2.984]

2 giờ trước, amateurday đã nói:

Hề hề, cao thủ mà hỏi thế này thì không ổn nghen.

 

2 giờ trước, Doan Van Ha đã nói:

Ủa, dễ mà. Quản lý tag của nó thôi.

 

1 giờ trước, nhatmufc đã nói:

Nếu làm lisp theo kiểu nhận diện tên tag thì mới tăng số thứ tự liệu có được không anh. Em cũng không rành về lisp lắm ạ ^^

Ý của ket là bài toán tổng quát, trong 1 block có nhiều Attdef, rõ ràng nếu muốn chạy tăng tự động thì phải biết Tag nào sẽ chịu tác động của lisp
Có mấy cách phổ biến sau : 
- All, Tag nào cũng tăng
- Chỉ định : sẵn trong code, hoặc hộp thoại chọn lựa
- All với điều kiện có số, có màu
....
Nói tóm lại là phải có nguyên tắc chỉ định
Ngoài nguyên tắc chỉ định TAG còn có nguyên tắc về cách tăng : Số / Chữ / Both ? Gia số ? Số ký tự nhỏ nhất ? Số ký tự lớn nhất ? Lặp lại ? blah blah ...
Nói chung còn nhiều vấn đề
Nên, ket mới hỏi để  OP suy nghĩ kỹ hơn về bài toán của mình để mô tả rõ hơn trước khi tìm sự trợ giúp

[nhatmufc 0]

10 phút trước, ketxu đã nói:

 

 

Ý của ket là bài toán tổng quát, trong 1 block có nhiều Attdef, rõ ràng nếu muốn chạy tăng tự động thì phải biết Tag nào sẽ chịu tác động của lisp
Có mấy cách phổ biến sau : 
- All, Tag nào cũng tăng
- Chỉ định : sẵn trong code, hoặc hộp thoại chọn lựa
- All với điều kiện có số, có màu
....
Nói tóm lại là phải có nguyên tắc chỉ định
Ngoài nguyên tắc chỉ định TAG còn có nguyên tắc về cách tăng : Số / Chữ / Both ? Gia số ? Số ký tự nhỏ nhất ? Số ký tự lớn nhất ? Lặp lại ? blah blah ...
Nói chung còn nhiều vấn đề
Nên, ket mới hỏi để  OP suy nghĩ kỹ hơn về bài toán của mình để mô tả rõ hơn trước khi tìm sự trợ giúp

Em nghĩ nếu về lisp chung thì khi mình nhập lệnh -> chọn block -> chọn các tag mà mình muốn tăng số thứ tự -> chọn vị trí -> chọn điểm đặt thì anh thấy thế nào ạ
Tại các lisp tăng số thứ tự ATT block e tìm được đều chỉ cho chọn một tag
Em cảm ơn anh

[nhatmufc 0]

31 phút trước, Nguyễn Hà Huy đã nói:

Lisp của bác @Duong Nhat Duy làm được nhé, lệnh STT. Xem video để ở dưới xem đúng ý bạn ko

Animation.rar

Trong video e thấy anh nhập lệnh DSTT, em có down lisp của anh @Duong Nhat Duy để làm thử thì lại không có lệnh DSTT ạ 

 

[tannguyen291 135]

Thế này được tính là tổng quát chưa mọi người nhỉ. :)

[Nguyễn Hà Huy 31]

1 giờ trước, nhatmufc đã nói:

Trong video e thấy anh nhập lệnh DSTT, em có down lisp của anh @Duong Nhat Duy để làm thử thì lại không có lệnh DSTT ạ 

 

mình đổi lệnh do trùng 1 lệnh ko sửa đc ấy mà, vẫn lisp của bác duy thôi, nguồn mở

[nhatmufc 0]

13 phút trước, tannguyen291 đã nói:

Thế này được tính là tổng quát chưa mọi người nhỉ. :)

Anh cho e xin lisp này với ạ. Em xin cảm ơn

[amateurday 15]

12 phút trước, tannguyen291 đã nói:

Thế này được tính là tổng quát chưa mọi người nhỉ. :)

Nếu tổng quát thì mỗi tag sẽ có increment (abc, 123) riêng chứ, rồi suffix, pre, số số 0. Hehe, sợ còn chưa tổng quát nữa chứ.

[tannguyen291 135]

37 phút trước, amateurday đã nói:

Nếu tổng quát thì mỗi tag sẽ có increment (abc, 123) riêng chứ, rồi suffix, pre, số số 0. Hehe, sợ còn chưa tổng quát nữa chứ.

hehe, đúng là chưa tổng quát thật.

số số 0 thì không quan trọng lắm. đặt tên đầu tiên có bao nhiêu số 0 thì về sau cứ thế. 

mỗi tag 1 incre, pre, suf thì chỉ ngại viết DCL

thôi thì thớt dùng tạm cái này đi vậy

(defun c:ctd (/ ss getss)
  (setq ss (entsel "\nSelect text or att block: "))
  (cond
    ( (not ss) (c:ctd) )
    ( (and (setq getss (entget (car ss))) (= "INSERT" (cdr (assoc 0 getss))) (assoc 66 getss))
      (ocadeoca (car ss))
    )
    ( (member (cdr (assoc 0 getss)) '("TEXT" "MTEXT"))
      (ocadeoc (car ss))
    )
    (t (c:ctd))
  )
  (princ)
)

(defun ocadeoc (e /  dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
  (setq
    dn (getint "\nIncrement <1>: ")
    e (vlax-ename->vla-object e)
    cn (vla-get-textstring e)
  )
  (redraw (vlax-vla-object->ename e) 3)
  (setq p1 (getpoint "\nBase point:"))
  (if (not dn) (setq dn 1))
  (while (setq p2 (getpoint p1 "\nNew point <exit>: "))
    (redraw (vlax-vla-object->ename e) 4)
    (VLA-MOVE (setq e (VLA-COPY e)) (vlax-3d-point p1) (vlax-3d-point p2))  
    (setq
      cn (incc cn dn)
      p1 p2
    )
    (vla-put-textstring e cn)
  )
  (redraw (vlax-vla-object->ename e) 4)
)


(defun ocadeoca ( e0 / att lsatt dn p1 p2 itm) ;;;Make Ordinal number. Copy from Atttribute block
  (setq
    e0 (vlax-ename->vla-object e0)
    att (mapcar '(lambda (x) (cons (vla-get-tagstring x) (vla-get-textstring x))) (vlax-invoke e0 'getattributes))
    lsatt (listbox_oca "Select an attribute increment." (mapcar 'car att) 1)
    dn (car lsatt)
    lsatt (mapcar '(lambda (x) (assoc x att)) (cdr lsatt))
  )
  (if lsatt
    (progn
      (redraw (vlax-vla-object->ename e0) 3)
      (setq p1 (getpoint "\nBase point:"))
      (while (setq p2 (getpoint p1 "\nNew point <exit>: "))
        (redraw (vlax-vla-object->ename e0) 4)
        (VLA-MOVE (setq e0 (VLA-COPY e0)) (vlax-3d-point p1) (vlax-3d-point p2) )
        (setq
          att (mapcar '(lambda (x) (incc (cdr x) dn)) lsatt)
          lsatt (mapcar 'cons (mapcar 'car lsatt) att)
          p1 p2
        )
        (foreach att (vlax-invoke e0 'getattributes)
          (if (setq itm (assoc (vla-get-tagstring att) lsatt))
            (vla-put-textstring att (cdr itm))
          )
        )
        (redraw (vlax-vla-object->ename e0) 3)
      )
      (redraw (vlax-vla-object->ename e0) 4)
    )
  )

)

(defun inc65 (c dn / i c1 c2)
  (setq
    i (strlen c)
    c1 (substr c 1 (- i 1))
    c2 (+ dn (ascii (substr c i 1)))
  )
  (cond 
    ( (< c2 91) (strcat c1 (chr c2)))
    ( (eq c1 "") (strcat "A" (chr (+ 64 (rem c2 90)))))
    (t (strcat (inc65 c1 1) (chr (+ 64 (rem c2 90)))))
  )
)

(defun inc97 (c dn / i c1 c2)
  (setq
    i (strlen c)
    c1 (substr c 1 (- i 1))
    c2 (+ dn (ascii (substr c i 1)))
  )
  (cond 
    ( (< c2 123) (strcat c1 (chr c2)))
    ( (eq c1 "") (strcat "a" (chr (+ 96 (rem c2 122)))))
    (t (strcat (inc97 c1 1) (chr (+ 96 (rem c2 122)))))
  )
)

(defun incC (c dn / c1 c2 n) ;;;Increase character c
  (setq c2 (ascii (substr c (strlen c) 1)) )
  (cond
    ( (and (< c2 91) (> c2 64))
      (setq 
        c1 (vl-string-right-trim "ABCDEFGHIJKLMNOPQRSTUVWXYZ" c)
        c2 (vl-string-subst "" c1 c)
        c2 (inc65 c2 dn)
      )
      (strcat c1 c2)
    )
    ( (and (< c2 123) (> c2 96) )
      (setq 
        c1 (vl-string-right-trim "abcdefghijklmnopqrstuvwxyz" c)
        c2 (vl-string-subst "" c1 c)
        c2 (inc97 c2 dn)
      )
      (strcat c1 c2)
    )
    ( (and (< c2 58) (> c2 47) )
      (setq 
        c1 (vl-string-right-trim "0123456789" c)
        c2 (vl-string-subst "" c1 c)
        n (itoa (+ dn (atoi c2)))
      )
      (while (< (strlen n) (strlen c2))
        (setq n (strcat "0" n))
      )
      (strcat c1 n)
    )
    (t c)
  )
)

(defun listbox_oca ( msg lst bit / dch des tmp rtn ix )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}"
                                ": edit_box { label = \"*Increment:\"; key = \"Edit\"; edit_width = 20;}"
                                "spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (set_tile "Edit" (setq ix "1"))
            (action_tile "list" "(setq rtn $value)")
            (action_tile "Edit" "(setq ix $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    (if rtn (cons (atoi ix) rtn))
)

 

[nhatmufc 0]

45 phút trước, tannguyen291 đã nói:

hehe, đúng là chưa tổng quát thật.

số số 0 thì không quan trọng lắm. đặt tên đầu tiên có bao nhiêu số 0 thì về sau cứ thế. 

mỗi tag 1 incre, pre, suf thì chỉ ngại viết DCL

thôi thì thớt dùng tạm cái này đi vậy

(defun c:ctd (/ ss getss)
  (setq ss (entsel "\nSelect text or att block: "))
  (cond
    ( (not ss) (c:ctd) )
    ( (and (setq getss (entget (car ss))) (= "INSERT" (cdr (assoc 0 getss))) (assoc 66 getss))
      (ocadeoca (car ss))
    )
    ( (member (cdr (assoc 0 getss)) '("TEXT" "MTEXT"))
      (ocadeoc (car ss))
    )
    (t (c:ctd))
  )
  (princ)
)

(defun ocadeoc (e /  dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
  (setq
    dn (getint "\nIncrement <1>: ")
    e (vlax-ename->vla-object e)
    cn (vla-get-textstring e)
  )
  (redraw (vlax-vla-object->ename e) 3)
  (setq p1 (getpoint "\nBase point:"))
  (if (not dn) (setq dn 1))
  (while (setq p2 (getpoint p1 "\nNew point <exit>: "))
    (redraw (vlax-vla-object->ename e) 4)
    (VLA-MOVE (setq e (VLA-COPY e)) (vlax-3d-point p1) (vlax-3d-point p2))  
    (setq
      cn (incc cn dn)
      p1 p2
    )
    (vla-put-textstring e cn)
  )
  (redraw (vlax-vla-object->ename e) 4)
)


(defun ocadeoca ( e0 / att lsatt dn p1 p2 itm) ;;;Make Ordinal number. Copy from Atttribute block
  (setq
    e0 (vlax-ename->vla-object e0)
    att (mapcar '(lambda (x) (cons (vla-get-tagstring x) (vla-get-textstring x))) (vlax-invoke e0 'getattributes))
    lsatt (listbox_oca "Select an attribute increment." (mapcar 'car att) 1)
    dn (car lsatt)
    lsatt (mapcar '(lambda (x) (assoc x att)) (cdr lsatt))
  )
  (if lsatt
    (progn
      (redraw (vlax-vla-object->ename e0) 3)
      (setq p1 (getpoint "\nBase point:"))
      (while (setq p2 (getpoint p1 "\nNew point <exit>: "))
        (redraw (vlax-vla-object->ename e0) 4)
        (VLA-MOVE (setq e0 (VLA-COPY e0)) (vlax-3d-point p1) (vlax-3d-point p2) )
        (setq
          att (mapcar '(lambda (x) (incc (cdr x) dn)) lsatt)
          lsatt (mapcar 'cons (mapcar 'car lsatt) att)
          p1 p2
        )
        (foreach att (vlax-invoke e0 'getattributes)
          (if (setq itm (assoc (vla-get-tagstring att) lsatt))
            (vla-put-textstring att (cdr itm))
          )
        )
        (redraw (vlax-vla-object->ename e0) 3)
      )
      (redraw (vlax-vla-object->ename e0) 4)
    )
  )

)

(defun inc65 (c dn / i c1 c2)
  (setq
    i (strlen c)
    c1 (substr c 1 (- i 1))
    c2 (+ dn (ascii (substr c i 1)))
  )
  (cond 
    ( (< c2 91) (strcat c1 (chr c2)))
    ( (eq c1 "") (strcat "A" (chr (+ 64 (rem c2 90)))))
    (t (strcat (inc65 c1 1) (chr (+ 64 (rem c2 90)))))
  )
)

(defun inc97 (c dn / i c1 c2)
  (setq
    i (strlen c)
    c1 (substr c 1 (- i 1))
    c2 (+ dn (ascii (substr c i 1)))
  )
  (cond 
    ( (< c2 123) (strcat c1 (chr c2)))
    ( (eq c1 "") (strcat "a" (chr (+ 96 (rem c2 122)))))
    (t (strcat (inc97 c1 1) (chr (+ 96 (rem c2 122)))))
  )
)

(defun incC (c dn / c1 c2 n) ;;;Increase character c
  (setq c2 (ascii (substr c (strlen c) 1)) )
  (cond
    ( (and (< c2 91) (> c2 64))
      (setq 
        c1 (vl-string-right-trim "ABCDEFGHIJKLMNOPQRSTUVWXYZ" c)
        c2 (vl-string-subst "" c1 c)
        c2 (inc65 c2 dn)
      )
      (strcat c1 c2)
    )
    ( (and (< c2 123) (> c2 96) )
      (setq 
        c1 (vl-string-right-trim "abcdefghijklmnopqrstuvwxyz" c)
        c2 (vl-string-subst "" c1 c)
        c2 (inc97 c2 dn)
      )
      (strcat c1 c2)
    )
    ( (and (< c2 58) (> c2 47) )
      (setq 
        c1 (vl-string-right-trim "0123456789" c)
        c2 (vl-string-subst "" c1 c)
        n (itoa (+ dn (atoi c2)))
      )
      (while (< (strlen n) (strlen c2))
        (setq n (strcat "0" n))
      )
      (strcat c1 n)
    )
    (t c)
  )
)

(defun listbox_oca ( msg lst bit / dch des tmp rtn ix )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}"
                                ": edit_box { label = \"*Increment:\"; key = \"Edit\"; edit_width = 20;}"
                                "spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (set_tile "Edit" (setq ix "1"))
            (action_tile "list" "(setq rtn $value)")
            (action_tile "Edit" "(setq ix $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    (if rtn (cons (atoi ix) rtn))
)

 

 

Em đã thử và làm được ạ. Em cảm ơn anh nhiều ạ