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

Lỗi lisp cad đánh số tự động

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

Chào các anh em, mình có một đoạn lisp cad tải trên trang này. Mình có sửa đổi lại đôi chút để phù hợp hơn với nhu cầu. Nhưng không hiểu vì sao đoạn code không thể chèn thêm 2 số 0 vào mã số ở giữa để đủ 11 ký tự. VD: mình muốn A.01.001.01-->A.01.002.01, nhưng dùng lisp này chỉ có thể đánh thành A.01.1.01. Rất mong nhận được sự giúp đỡ! Mình cảm ơn!

(defun C:CV (/ dsdt dt dt1 dt2 p1 p2 sl x kwrd strt strp num sym ds daup giaso)					;khai bao hàm
(vl-load-com) (command "undo" "be") (setq osm (getvar "osmode") cmd (getvar "cmdecho"))
(setq giaso (getreal "\nGia so tang/giam: "))									;nhan gia so tu ban phim
(princ "\nChon cac doi tuong can Copy tang/giam...")
(setq dsdt (vl-remove-if 'listp (mapcar 'cadr (ssnamex (setq dt (ssget)))))
   		dt1 dt p1 (getpoint "\nDiem goc: ") x 1)
(foreach n dsdt
  (if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
   (if (KT_NUM (cdr (assoc 1 (entget n))))
	(setq dt2 n))))
(if dt2 (setq dt1 (ssdel dt2 dt) dt3 dt1))
(while (setq p2 (getpoint p1 "\nDiem den: "))
  (setvar "osmode" 0) (setvar "cmdecho" 0)
  (if dt2
   (progn
	(command ".copy" dt2 "" p1 p2)
	(CHIA3 (cdr (assoc 1 (entget dt2))))
	(setq daup 0)		;(if (not (vl-string-search "." (cadr ds))) 0 (- (strlen (cadr ds)) (vl-string-search "." (cadr ds)) 1)) ; gan daup la so chu so sau dau thap phan
	(entmod (subst (cons 1 (strcat (car ds) (THEM0 (cadr ds) (rtos (+ (atof (cadr ds)) (* x giaso)) 2 daup)) (caddr ds))) (assoc 1 (entget (entlast))) (entget (entlast))))
	(entupd (entlast))
	(setq x (1+ x))))
  (if dt1
   (command ".copy" dt1 "" p1 p2)))
(command "undo" "e") (setvar "osmode" osm) (setvar "cmdecho" cmd) (princ))
;----- Chia text ra tiento_num_hauto.
(defun CHIA3 (str / trai phai lstt lstn)
(setq lstt (vl-string->list str) lstn (reverse lstt))							;chuyen chuoi ky tu str sang ASCII code
;(while lstt
;  (cond ((or (< (car lstt) 48) (> (car lstt) 57)) (setq trai (cons (car lstt) trai) lstt (cdr lstt)))
 ;			(T (setq lstt nil))))
;(while lstn
;  (cond ((or (< (car lstn) 48) (> (car lstn) 57)) (setq phai (cons (car lstn) phai) lstn (cdr lstn)))
; 			(T (setq lstn nil))))
(setq phai (cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr lstt)))))))))				;set trai la tien to
  (setq trai (cdr(cdr(cdr(cdr(cdr(cdr lstn)))))))					;set phai la hau to
  (setq ds (list (vl-list->string (reverse trai))
                    	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-string-right-trim (vl-list->string phai) (vl-string-left-trim (vl-list->string trai) str)))
                    	(if (= (strlen str) (strlen (vl-list->string (reverse trai)))) "" (vl-list->string phai)))))
;----- Kiem tra 1 text co chua num hay khong?
(defun KT_NUM(str / ds kt)
(foreach n (vl-string->list str)
  (if (and (>= n 48) (<= n 57)) (setq kt T)))
kt)
;----- Thong ke so chu so truoc dau thap phan.
(defun KT_FIX(str / m)
(setq m 0)
(while (and (> (strlen str) 0) (/= (substr str 1 1) "."))
  (setq m (1+ m) str (substr str 2)))
m)
;----- Them so chu so 0 vao dau text cho phu hop.
(defun THEM0(strt strs)
(while (> (- (KT_FIX strt) (KT_FIX strs)) 0)
  (setq strs (strcat "0" strs)))
strs)


 

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  

×