Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
mrphuocvie

Nhờ các anh chị giúp 1 đoạn LISP!

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

Hi ! Xin nhờ mọi người sửa giúp lisp copy thứ tứ tăng dần của tác giả interwar1283, trong lisp này chỉ cho copy đến 99 rồi lại về 0, nhờ mọi người sửa hộ lisp cho copy lên đến 1000. xin chân thành cảm ơn ! http://www.cadviet.com/forum/topic/1398-danh-so-thu-tu-tang-dan/

;; free lisp from cadviet.com
;;;Edit by Interwar1283
;*********************************************************************
(defun ketthuc ()
(setvar "cmdecho" luuecho)
(setq *error* luu
luu nil
luuecho nil
);setq
(princ)
)
;*********************************************************************
(defun modau ()
(setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq kytu (substr text (strlen text))
ma (ascii kytu)
sokt (read kytu) 
lui 1
)
(if (numberp sokt)
(progn
(setq luusokt (1+ sokt))
(if (and (numberp sokt) 
(> (strlen text) 1)
   )
  (progn
(setq kytu (substr text (1- (strlen text)))
sokt (read kytu) 
)
(if (numberp sokt) 
(setq luusokt (1+ sokt)
lui 2
 
)
)
   );progn
)
(if (= luusokt> 100) (setq luusokt 0))
(setq kytu (rtos luusokt 2 0)
 
text (strcat (substr text 1 (- (strlen text) lui))  kytu)
)
);progn
(if   (or (= kytu "z")
(= kytu "Z")
)
(setq text (strcat text "0")
textxl "0"
)
(setq ma (1+ ma)
text (strcat (substr text 1 (1- (strlen text)))  (chr ma))
)
);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq doituong (entget  tendoituong)
kieu (cdr (assoc 0 doituong))
canle (cdr (assoc 72 doituong))
)
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
    )
(progn
(setq textxl (xulytext textxl)
text (cons 1 textxl)
vitri10 (cdr (assoc 10 doituong))
vitri10 (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
vitri10 (cons 10 vitri10)
vitri11 (cdr (assoc 11 doituong))
vitri11 (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
vitri11 (cons 11 vitri11)
dem 0
dsach nil
)
(foreach tam doituong
(cond
((= (car tam) 1) (setq dsach (append dsach (list text))))
((= (car tam) 10) (setq dsach (append dsach (list vitri10))))
((= (car tam) 11) (setq dsach (append dsach (list vitri11))))
((setq dsach (append dsach (list tam))))
)
)
(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi
 
(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun
 
;*********************************************************************
(defun c:coo ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nSelect base point:")
thoat nil
dem 0
textxl nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while (and (= thoat nil)
(< dem dodai)
)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)
 
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
       )
(setq thoat T
textxl (cdr (assoc 1 doituong))
)
)
);
(while T 
(setq toi (getpoint "\nSelect next point: " goc)
vitrilech (list (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem 0
)
(while (< dem dodai)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)
 
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
       )
(doitext ten)
(copy_dt ten)
 
);if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

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

Không đơn giản vậy đâu bác HA ơi!! Nếu vậy thì sau số 100 sẽ là số 11!!

Nếu text chỉ là các con số mà không có chữ thì có thể sửa hàm xulytext như thế này:

 

(defun xulytext (text / sokt luusokt)
  (if (numberp (setq sokt (read text)))
    (progn
      (setq luusokt (1+ sokt))
      (if (= luusokt 1001)
(setq luusokt 1)
      )
      (setq  text (rtos luusokt 2 0)
      )
    )
  )
)

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

Bạn thử cái này. Tôi chỉ sửa hàm xulytext thôi , còn chỗ khác để nguyên.

 

(defun ketthuc ()
  (setvar "cmdecho" luuecho)
  (setq *error* luu
luu nil
luuecho nil
  ) 
  (princ)
)
 
(defun modau ()
  (setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
  )
)
 
(defun xulytext (text / sokt  )
  (setq sokt (last (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (or (< x 48) (> x 57)) 32 x)) (vl-string->list text))) ")")))
luusokt (1+ sokt))  
  (if (> luusokt 1000)
    (setq luusokt 1)
  )
  (setq text (vl-string-subst (rtos luusokt 2 0) (rtos sokt 2 0) text ))
)
 
(defun doitext (tendoituong     /       chuoi doituong
thoat   tam     dsach     kieu text
vitri10   vitri11   dem       canle
      )
 
  (setq doituong (entget tendoituong)
kieu  (cdr (assoc 0 doituong))
canle  (cdr (assoc 72 doituong))
  )
  (if (or (= kieu "TEXT")
 (= kieu "MTEXT")
      )
    (progn
      (setq textxl  (xulytext textxl)
   text    (cons 1 textxl)
   vitri10 (cdr (assoc 10 doituong))
   vitri10 (list (+ (car vitri10) (car vitrilech))
 (+ (nth 1 vitri10) (nth 1 vitrilech))
   )
   vitri10 (cons 10 vitri10)
   vitri11 (cdr (assoc 11 doituong))
   vitri11 (list (+ (car vitri11) (car vitrilech))
 (+ (nth 1 vitri11) (nth 1 vitrilech))
   )
   vitri11 (cons 11 vitri11)
   dem     0
   dsach   nil
      )
      (foreach tam doituong
(cond
 ((= (car tam) 1) (setq dsach (append dsach (list text))))
 ((= (car tam) 10)
  (setq dsach (append dsach (list vitri10)))
 )
 ((= (car tam) 11)
  (setq dsach (append dsach (list vitri11)))
 )
 ((setq dsach (append dsach (list tam))))
)
      )
      (entmake dsach)
    ) ;progn
  ) ;if
) ;
;*********************************************************************
;sao doi tuong cu sang vi tri moi
 
(defun copy_dt (tendoituong)
  (command "copy" tendoituong "" goc toi)
) ;defun
 
;*********************************************************************
(defun c:coo (/ cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
  (princ "\nCopy Inteligent...\n")
  (setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nSelect base point:")
thoat nil
dem 0
textxl nil
  ) ;
  (setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
  (while (and (= thoat nil)
     (< dem dodai)
)
    (setq ten    (ssname cumdt dem)
 dem    (1+ dem)
 doituong (entget ten)
 kieu    (cdr (assoc 0 doituong))
    )
 
    (if (or (= kieu "TEXT")
   (= kieu "MTEXT")
)
      (setq thoat  T
   textxl (cdr (assoc 1 doituong))
      )
    )
  ) ;
  (while T
    (setq toi     (getpoint "\nSelect next point: " goc)
 vitrilech (list (- (car toi) (car goc))
 (- (nth 1 toi) (nth 1 goc))
   )
 dem     0
    )
    (while (< dem dodai)
      (setq ten      (ssname cumdt dem)
   dem      (1+ dem)
   doituong (entget ten)
   kieu     (cdr (assoc 0 doituong))
      )
 
      (if (or (= kieu "TEXT")
     (= kieu "MTEXT")
 )
(doitext ten)
(copy_dt ten)
 
      ) ;if
    )
  ) ;while
  (ketthuc)
) ;defun
(princ "Type \"DG\" to start")
  • 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

 

Bạn thử cái này. Tôi chỉ sửa hàm xulytext thôi , còn chỗ khác để nguyên.

 

(defun ketthuc ()
  (setvar "cmdecho" luuecho)
  (setq *error* luu
luu nil
luuecho nil
  ) 
  (princ)
)
 
(defun modau ()
  (setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
  )
)
 
(defun xulytext (text / sokt  )
  (setq sokt (last (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (or (< x 48) (> x 57)) 32 x)) (vl-string->list text))) ")")))
luusokt (1+ sokt))  
  (if (> luusokt 1000)
    (setq luusokt 1)
  )
  (setq text (vl-string-subst (rtos luusokt 2 0) (rtos sokt 2 0) text ))
)
 
(defun doitext (tendoituong     /       chuoi doituong
thoat   tam     dsach     kieu text
vitri10   vitri11   dem       canle
      )
 
  (setq doituong (entget tendoituong)
kieu  (cdr (assoc 0 doituong))
canle  (cdr (assoc 72 doituong))
  )
  (if (or (= kieu "TEXT")
 (= kieu "MTEXT")
      )
    (progn
      (setq textxl  (xulytext textxl)
   text    (cons 1 textxl)
   vitri10 (cdr (assoc 10 doituong))
   vitri10 (list (+ (car vitri10) (car vitrilech))
 (+ (nth 1 vitri10) (nth 1 vitrilech))
   )
   vitri10 (cons 10 vitri10)
   vitri11 (cdr (assoc 11 doituong))
   vitri11 (list (+ (car vitri11) (car vitrilech))
 (+ (nth 1 vitri11) (nth 1 vitrilech))
   )
   vitri11 (cons 11 vitri11)
   dem     0
   dsach   nil
      )
      (foreach tam doituong
(cond
 ((= (car tam) 1) (setq dsach (append dsach (list text))))
 ((= (car tam) 10)
  (setq dsach (append dsach (list vitri10)))
 )
 ((= (car tam) 11)
  (setq dsach (append dsach (list vitri11)))
 )
 ((setq dsach (append dsach (list tam))))
)
      )
      (entmake dsach)
    ) ;progn
  ) ;if
) ;
;*********************************************************************
;sao doi tuong cu sang vi tri moi
 
(defun copy_dt (tendoituong)
  (command "copy" tendoituong "" goc toi)
) ;defun
 
;*********************************************************************
(defun c:coo (/ cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
  (princ "\nCopy Inteligent...\n")
  (setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nSelect base point:")
thoat nil
dem 0
textxl nil
  ) ;
  (setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
  (while (and (= thoat nil)
     (< dem dodai)
)
    (setq ten    (ssname cumdt dem)
 dem    (1+ dem)
 doituong (entget ten)
 kieu    (cdr (assoc 0 doituong))
    )
 
    (if (or (= kieu "TEXT")
   (= kieu "MTEXT")
)
      (setq thoat  T
   textxl (cdr (assoc 1 doituong))
      )
    )
  ) ;
  (while T
    (setq toi     (getpoint "\nSelect next point: " goc)
 vitrilech (list (- (car toi) (car goc))
 (- (nth 1 toi) (nth 1 goc))
   )
 dem     0
    )
    (while (< dem dodai)
      (setq ten      (ssname cumdt dem)
   dem      (1+ dem)
   doituong (entget ten)
   kieu     (cdr (assoc 0 doituong))
      )
 
      (if (or (= kieu "TEXT")
     (= kieu "MTEXT")
 )
(doitext ten)
(copy_dt ten)
 
      ) ;if
    )
  ) ;while
  (ketthuc)
) ;defun
(princ "Type \"DG\" to start")

Đúng như ý mình , Thank you !

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  

×