Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
9 replies to this topic

#1 victor85

victor85

    biết lệnh stretch

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

Đã gửi 19 February 2016 - 04:01 PM

Đặ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é :)


  • -1

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 19 February 2016 - 04:20 PM

Ví dụ chuỗi ban đầu là ABCD12XYZ và muốn copy tăng thành ABCD13XYZ, ABCD14XYZ... thì nhập kiểu gì?


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 victor85

victor85

    biết lệnh stretch

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

Đã gửi 19 February 2016 - 04:38 PM

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.


  • 0

#4 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 20 February 2016 - 10:22 AM

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)
)


  • 2

#5 whatcholingon

whatcholingon

    biết lệnh break

  • Members
  • PipPipPipPip
  • 222 Bài viết
Điểm đánh giá: 37 (tàm tạm)

Đã gửi 20 February 2016 - 10:50 AM

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)
)
;;;============================



  • 1

#6 frpx123

frpx123

    biết pan

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

Đã gửi 22 February 2016 - 08:51 AM

hỏi. mình hỏi có lệnh copy nào như thế này ko ?

 

ví dụ: có 3 số 1 2 3 copy thông mình quét cả 3 số nó nhảy lên 4 5 6


  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 22 February 2016 - 06:40 PM

Thử cái này xem:

http://www.lee-mac.c...attributes.html


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 minhtri2701

minhtri2701

    biết lệnh copy

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

Đã gửi 26 February 2016 - 02:15 PM

Thử cái này xem:

http://www.lee-mac.c...attributes.html

Bác  Doan Van Ha xin chỉ giúp mình là cái lisp trên dùng lệnh gì vậy, mình có mở tải về nhưng chưa biết sử dụng

Thanks Bác


  • 0

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 26 February 2016 - 02:38 PM

Bạn xem hướng dẫn cách dùng lisp này ở đây:

http://www.cadviet.c...g-sau-thay-a-i/


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 minhtri2701

minhtri2701

    biết lệnh copy

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

Đã gửi 26 February 2016 - 03:06 PM

Bạn xem hướng dẫn cách dùng lisp này ở đây:

http://www.cadviet.c...g-sau-thay-a-i/

Cảm ơn bác Doan Van Ha


  • 0