Đến nội dung


Hình ảnh
- - - - -

Lisp tăng số trong text nhưng chỉ được tối đa 100


  • Please log in to reply
4 replies to this topic

#1 ainhandilac

ainhandilac

    biết vẽ pline

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

Đã gửi 31 August 2007 - 10:13 AM

thứ nhất cái lệnh copy text chỉ tăng đến 100 là dừng, nhờ các thí chủ hiệu chỉnh lại hộ

(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:cp ( / 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 \"CP\" to start")
;Note: bien toan cuc: textxl vitrilech
thứ hai cai lisp cập nhất khoảng cách và góc quay cua bần tăng chỉ chạy đúng khi điểm cuối cùng phải click đến hai lần, còn click 1 lần thì nó ko nhận nhờ pác Nguyễn Hoành xem hộ và chỉ giáo nhé
(Defun C:ktd ()
(PROMPT "CHU Y, TY LE BAN VE LA 1M = 1000 DON VI")

(SETQ FN1 (GETFILED "CHON TEN FILE GHI KHOANG CACH VA GOC QUAY MAT BANG" "" "xls" 1)) ; tao file
;(SETQ FN2 (GETFILED "CHON TEN FILE goc quay Y" "" "xls" 1)) ; tao file
(IF (NULL FN1)
(PRINC "CHUA CHON TEN"); eslse
(PROGN
(SETQ PW1 (OPEN FN1 "a")) ; mo file
(SETQ ghichu "TENCOC K/C GOCQUAY")
(WRITE-line ghichu PW1)
;(SETQ PW2 (OPEN FN2 "a"))
(setq n (GETreal"\nCHON SO COC"))
;-******************************************************
(princ "chon diem so ")
(princ n )
(princ " (")
(princ n)
(SETQ A (GETPOINT "\nth point)")) ; chon diem
(print)
(command "insert" "COC" A "" "" "" ) ; insert coc
(setq l1 0)
(setq n1 (rtos n 2 0))
(SETQ L4 (STRCAT n1 " " "0" " " "0"))
(WRITE-line l4 PW1)
(setq n (+ 1 n));2
;***********************************
(princ "chon diem so ")
(princ n )
(princ " (")
(princ n)
(SETQ b (GETPOINT "th point)"))
(print)
(command "insert" "COC" b "" "" "" )
(setq L3 (distance A :unsure:)
(setq l4 (rtos (/ L3 1000) 2 2))
;(WRITE-line l4 PW1); k/c 1 -2 ok
;bat dau tinh goc 1 - 2
(setq goc1 (angle a :unsure:)
(setq gocdo (cvunit goc1 "radians""degree"))
(setq ghigoc (rtos gocdo 2 2))

;(write-line ghigoc PW2)
;*********************************
(princ "chon diem so ")
(princ (+ 1 n) )
(princ " (")
(princ (+ 1 n))
(SETQ c (GETPOINT "th point)"))
(print)
(command "insert" "COC" c "" "" "" )
;(WRITE-line l4 PW1); k/c 1 -2 ok
;bat dau tinh goc 1 - 2
(setq goc2 (angle b c))
(setq goc (+ pi (- goc2 goc1)))
(setq gocdo (cvunit goc "radians""degree"))
(if (<= gocdo 180)
(setq ghigoc (rtos (abs gocdo) 2 2))
(progn
(setq doi (abs (- 360 gocdo)))
(setq ghigoc (rtos doi 2 2))
)
)
(setq n1 (rtos n 2 0))
(SETQ L4 (STRCAT n1 " " l4 " " ghigoc))
(WRITE-line l4 PW1)

(setq L5 (distance b c))
(setq l6 (rtos (/ L5 1000) 2 2))
(setq n (+ 1 n));3
;**********************************************
(setq dk "t")
(WHILE (= dk "t");bat dau while
(princ "chon diem so ")
(princ (+ 1 n))
(princ " (")
(princ (+ 1 n))
(SETQ d (GETPOINT "th point)"));diem 3
(print)
(command "insert" "COC" d "" "" "" )
;xong k/c 2-3 ok
;bat dau tinh goc 2 - 3
(setq goc3 (angle c d))
(setq goc (+ pi (- goc3 goc2)))
(setq gocdo (cvunit goc "radians""degree"))
(if (<= gocdo 180)
(setq ghigoc (rtos (abs gocdo) 2 2))
(progn
(setq doi (abs (- 360 gocdo)))
(setq ghigoc (rtos doi 2 2))
)
)
(setq n1 (rtos n 2 0))
(setq ghi (strcat n1 " " l6 " " ghigoc))
(write-line ghi PW1)
(setq L5 (distance c d))
(setq l6 (rtos (/ L5 1000) 2 2))
;xong goc2 - 3 ok
(setq goc2 goc3)
(setq c d)
(setq n (+ 1 n))

)
;dong while
(setq n1 (rtos n 2 0))
(setq ghi (strcat n1 " " l6 " " "0"))
(write-line ghi PW1)
(CLOSE PW1)
;(CLOSE PW2)
)
)
)
(print "type ktd to start")

  • 0
SỐNG TRÊN ĐỜI CẦN CÓ NIỀM TIN

#2 thanhlamct

thanhlamct

    biết lệnh offset

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

Đã gửi 31 August 2007 - 01:10 PM

thứ nhất cái lệnh copy text chỉ tăng đến 100 là dừng, nhờ các thí chủ hiệu chỉnh lại hộ

Mình đã chỉnh lại, copy đến 999..
(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:co ( / 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

  • 0

#3 ainhandilac

ainhandilac

    biết vẽ pline

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

Đã gửi 31 August 2007 - 01:36 PM

Mình đã chỉnh lại, copy đến 999..

(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:co ( / 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

vẫn chưa đưoc pac thanhlamct oi, pac xem lại cho em cái
  • 0
SỐNG TRÊN ĐỜI CẦN CÓ NIỀM TIN

#4 thanhlamct

thanhlamct

    biết lệnh offset

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

Đã gửi 31 August 2007 - 05:18 PM

vẫn chưa đưoc pac thanhlamct oi, pac xem lại cho em cái

sory, post nhầm
(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 10000) (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:co ( / 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

  • 0

#5 ainhandilac

ainhandilac

    biết vẽ pline

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

Đã gửi 31 August 2007 - 08:47 PM

sory, post nhầm

(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 10000) (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:co ( / 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

pác này chơi nhau quá
chỉ copy từ 99 đén 100 thôi, sau đó lại nhảy lên 11, 12 ....
pác post lại cái nữa nhé!
  • 0
SỐNG TRÊN ĐỜI CẦN CÓ NIỀM TIN