Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
victor85

[Yêu Cầu] Nhờ Viết Lisp Copy Tăng Số Cải Tiến

Bởi victor85 , trong AutoLisp

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

victor85    10

victor85
Đã đăng

Đặt vấn đề: trước đến giờ chắc các bác đều có lisp copy tăng số để dùng rồi. Tuy nhiên mình chưa thấy thỏa mãn lisp đó trong nhiều trường hợp. Nay mình có ý này mong các bro xuống tay giúp đỡ xem có thể tổng quát copy tăng số được cho tất cả các chuỗi text chứ không đơn thuần là copy một số thông thường.

- Trường hợp 1:

Ví dụ: mình có chuỗi text có ký tự được viết là: ABCD9XYZ. Mình muốn copy nhảy số thành ABCD10XYZ; ABCD11XYZ; ABCD12XYZ ...

Cách thực hiện:

+Gõ lệnh: cpts. 

+Chọn chuỗi text bắt đầu: Chọn đối tượng là text ABCD9XYZ.

+Chọn vị trí để lấy kí tự nhảy số (trong trường hợp này là số "9" ở vị trí thứ 5 của chuỗi text) : ta gõ số 5 để lấy vị trí của kí tự nhảy số.

+ Bắt điểm gốc và điểm đến của đối tượng đển copy tăng số. Và được kết quả như đã nêu ạ.

- Trường hợp 2:

Ví dụ: mình có chuỗi text có ký tự được viết là: 111A222. Mình muốn copy nhảy số thành 111B222; 111C222; 111D222

làm tương tự trường hợp 1 nhưng chọn vị trí để nhảy số là số 4. Trong trường hợp này nó là ký tự text A thì nó sẽ nhảy thành B, C, D ... cho đến Z ạ.

( Nôm na là cái vị trí mà mình chọn là số thì nó sẽ nhảy thành số 1, 2, 3, 4 mà nó là text nó sẽ nhảy thành A, B, C, D ạ. Mình cũng có thể làm thủ công được cái này với kết hợp của lisp thêm text trên diễn đàn nhưng thực sự thủ công rất vất vả và tốn thời gian lắm)

 Mình nghĩ lisp này sẽ có ích và tổng quát được cho các trượng hợp mình gặp phải. Kính mong các bro giúp đỡ với ạ. Mình xin chân thành cảm ơn các bác trước nhé :)

  • Vote giảm 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

victor85    10

victor85
Đã đăng

Hè. Uh há. Đề chưa chặt. Thôi mong bác Hà kết hợp với lisp thêm text sau khi chọn copy đối tượng đầu (hoặc là 12, 13, 14, hoặc là A, B, C, D) sau đó hỏi chọn thêm tiền tố và hậu tố cho text ban đầu giúp mình vớ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

whatcholingon    45

whatcholingon
Đã đăng

Trường hợp 1: Bạn có thể sử dụng lsp này (không biết bản quyền của bà con cô dì chú bác nào cả)

;;;=====Increasing copy=====
(defun c:dsc (/ ang x y ent tg tg1tg2 num_r num_c num_inc dis_r dis_c num top idnum
dx dy bottom inc tgnum attr attr_ent t_base b_base locat value
deci stnum loca1 loca2 tt count inctg inctg1 bpoint mx my nx ny bx by)
(setq idnum 0)
(while (/= idnum 1)
(setq ent (entsel "\nHay lua chon so ma ban muon copy : "))
(if ent
(progn
(setq e (car ent))
(setq tg (entget e))
(if (= (cdr (assoc 0 tg)) "TEXT") (setq idnum 1))
)
(princ)
)
)

(setq num_inc (getreal "\nHay nhap he so tang giam <1> : "))
(if (= num_inc nil) (setq num_inc 1))

(setq bpoint (getpoint "\nChon diem goc de copy : "))
(setq x (car bpoint))
(setq y (car(cdr bpoint)))

(if (and (= (cdr (assoc 72 tg)) 0) (= (cdr (assoc 73 tg)) 0))
(progn
(setq bx (car (cdr (assoc 10 tg))))
(setq by (car (cdr (cdr (assoc 10 tg)))))
)
(progn
(setq bx (car (cdr (assoc 11 tg))))
(setq by (car (cdr (cdr (assoc 11 tg)))))
)
)

(setq attr (cdr tg)) ;attr chua cac thuoc tinh cua Entity nguon
(setq tg (cdr (assoc 1 tg)))
(setq inc 0)
(setq tg1 "")
(setq t_base "")
(setq b_base "")
(setq idnum 0)
(setq top 0)
(setq bottom 0)
(setq stnum "")
(setq deci 0)
(repeat (strlen tg)
(if (or (and (> (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1))) 47)
(< (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1))) 58))
(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1))) 32)
(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1))) 46))
(progn
(if (= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1))) 46) (setq deci inc))
(if (= inc 0)
(progn
(setq idnum 1)
(if (= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1))) 46)
(setq b_base (strcat "." b_base)))
)
)
(if (= bottom 1) (progn (setq bottom 0) (setq idnum 1) (setq top 1)))
(if (and (= idnum 0) (= top 1)) (setq t_base (strcat tgnum t_base)))
(if (= idnum 1)
(progn
(if (and (= tgnum "0") (> inc 0)) (setq stnum (strcat stnum "0")) (setq stnum ""))
(setq tg1 (strcat tgnum tg1))
)
)
)
(if (= inc 0)
(progn
(setq b_base (strcat tgnum b_base))
(setq bottom 1)
)
(if (= bottom 1)
(setq b_base (strcat tgnum b_base))
(progn
(setq top 1)
(setq t_base (strcat tgnum t_base))
(if (= idnum 1) (setq idnum 0))
)
)
)
)
(setq inc (+ inc 1))
)

(if (= tg1 "") (exit))
(setq num (atof tg1))
(setq count 1)

(while (setq bpoint (getpoint "\nChon diem copy tiep theo : "))
(setq num (+ num num_inc))
(if (>= (strlen b_base) 3)
(cond
( (or (= "A" (strcase (substr b_base 2 1))
)
(= "B" (strcase (substr b_base 2 1))
)
)
(setq b_base (strcat (substr b_base 1 1) (chr (1+ (ascii (substr b_base 2 1))) ) (substr b_base 3)
)
)
)
((= "C" (strcase (substr b_base 2 1)))
(setq b_base (strcat (substr b_base 1 1) "A") )
)
)
(cond
( (or (= "A" (strcase (substr b_base 2 1))
)
(= "B" (strcase (substr b_base 2 1))
)
)
(setq b_base (strcat (substr b_base 1 1) (chr (1+ (ascii (substr b_base 2 1))) ) (substr b_base 3)
)
)
)
((= "C" (strcase (substr b_base 2 1)))
(setq b_base (strcat (substr b_base 1 1) "A") )
)
)
)
(setq value (strcat t_base (strcat stnum (rtos num 2 deci)) b_base))
(setq nx (car bpoint))
(setq ny (car(cdr bpoint)))
(setq dx (- nx x))
(setq dy (- ny y))
(setq mx (car (getvar "ucsxdir")))
(setq my (car (cdr (getvar "ucsxdir"))))
(setq loca1 (+ bx (* mx dx)))
(setq loca2 (+ by (* my dx)))
(setq mx (car (getvar "ucsydir")))
(setq my (car (cdr (getvar "ucsydir"))))
(setq loca1 (+ loca1 (* mx dy)))
(setq loca2 (+ loca2 (* my dy)))
(setq attr_ent (subst (cons 1 value) (assoc 1 attr) attr))
(if (and (= (cdr (assoc 72 attr_ent)) 0) (= (cdr (assoc 73 attr_ent)) 0))
(setq attr_ent (subst (list 10 loca1 loca2 0) (assoc 10 attr_ent) attr_ent))
(setq attr_ent (subst (list 11 loca1 loca2 0) (assoc 11 attr_ent) attr_ent))
)
(entmake attr_ent)
(setq count (+ count 1))
) ;end while
(princ)
)
  • Vote tăng 2

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

whatcholingon    45

whatcholingon
Đã đăng

Trường hợp 2 thì bạn dùng lisp này, dùng lệnh OC ( tác giả như trên)   ( LỆNH OC DÙNG ĐƯỢC CHO CẢ 2 TRƯỜNG HỢP LUN)

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

;; 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)
)
;;;============================
  • 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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×