Đến nội dung


Hình ảnh
- - - - -

Lisp đánh chữ theo thứ tự???


  • Please log in to reply
36 replies to this topic

#1 colonbay

colonbay

    biết lệnh chamfer

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

Đã gửi 17 January 2007 - 06:29 PM

Em vẽ thang mà cứ ngồi FIX từng số 1 của text. Ghét. Có ai có lisp kiểu dạng đánh chư theo thứ tự koh? :lol:
  • 0
Hình đã gửi

Cấm vào nick!!

#2 Jin Yong

Jin Yong

    biết lệnh group

  • Vip
  • PipPipPipPipPipPip
  • 498 Bài viết
Điểm đánh giá: 334 (khá)

Đã gửi 17 January 2007 - 06:38 PM

Em vẽ thang mà cứ ngồi FIX từng số 1 của text. Ghét. Có ai có lisp kiểu dạng đánh chư theo thứ tự koh? :lol:


Việc viết code tự động đánh chữ theo thứ tự là khá đơn giản, nhưng bạn có thể mô tả kỹ hơn yêu cầu không, và có thể ví dụ bằng ảnh minh hoạ nữa
  • 1

Phát triển phần mềm thiết kế Kết cấu Việt Nam - http://www.ketcausoft.com


#3 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 17 January 2007 - 07:26 PM

code Autolisp:


(defun c:dchu (/ tdt csht sdt index tt entdt)
(defun thay (tt key moi / cu)
(setq cu (assoc key tt))
(subst (cons key moi) cu tt)
)
(setq tdt (ssget '((0 . "TEXT")))
csht (getint "\nSo bat dau: ")
sdt (sslength tdt)
index 0
)
(repeat sdt
(setq entdt (ssname tdt index)
index (1+ index)
tt (entget entdt)
tt (thay tt 1 (itoa csht))
csht (1+ csht)
)
(entmod tt)
(entupd entdt)
)
(princ)
)


Khi dùng lệnh, chỉ cần pick các text theo đúng thứ tự, là ok. Có thể dùng tham số f(ence) để chọn cho nhanh theo thứ tự.
Conlonbay dùng thử, có gì thì hồi âm nhé!
  • 1

#4 colonbay

colonbay

    biết lệnh chamfer

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

Đã gửi 17 January 2007 - 07:38 PM

em la COLONBAY chu khong phai CONLONBAY. Cam on anh vi cai LISP. Cai nay dung y em :lol:
  • 1
Hình đã gửi

Cấm vào nick!!

#5 Hieuss

Hieuss

    biết lệnh mtext

  • Vip
  • PipPipPipPip
  • 286 Bài viết
Điểm đánh giá: 163 (tàm tạm)

Đã gửi 19 January 2007 - 01:30 AM

(defun ketthuc ()
(setvar "cmdecho" luuecho)
(setq *error* luu
luu nil
luuecho nil
);setq
(princ "\nThe la het")
(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:ct ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(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))
)
)
);
(if (/= textxl nil)
(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
);if
(ketthuc)
);defun

;Note: bien toan cuc: textxl vitrilech


Đây cũng là một lisp dùng cho việc đánh số thứ tự bậc thang hoặc trục bao gồm cả số lẫn chữ nhưng dài dòng hơn lisp của Nguyen Hoanh . Tuy nhiên nếu dùng thì lisp này lại thuận tiện hơn ở 2 điểm:
- thứ nhất: lisp này dùng cho cả A,B,C sử dụng để đánh trục bản vẽ
- thứ hai: chỉ cần đánh lệnh CT rồi chọn đối tượng chuyển đến các chỗ mình cần . Chữ hoặc số bất kỳ sẽ tự động nhảy lên . Ví dụ: khi có một số giá trị là 5, gõ CT bắt 5 chuyển đến các vị trí khác, số thứ tự tự động sẽ là 6,7,8,.... tương tự với khi có một chữ là E, gõ CT bắt E chuyển đến các vị trí khác, chữ thứ tự tự động sẽ là F,G,H,..... Dùng thế này mình đỡ tốn được công đoạn pick lại số đã copy, hỏi số bắt đầu mà gói gọn hết lại thành duy nhất một công đoạn copy thôi . Các bạn thử dùng xem sao .
  • 4

#6 be_chanh

be_chanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 1712 Bài viết
Điểm đánh giá: 889 (rất tốt)

Đã gửi 19 January 2007 - 01:54 AM

Cái này cứ gọi là tiện bác hiếu a. Phen này COLONBAY tha hồ mà vẽ thang nhé :lol:
  • 0

t: 097.323.1199 | m: cudstk@gmail.com | w: http://www.aicollect.com


#7 hoai46ctt

hoai46ctt

    biết vẽ spline

  • Members
  • PipPip
  • 91 Bài viết
Điểm đánh giá: 33 (tàm tạm)

Đã gửi 21 June 2007 - 11:40 AM

Lisp này rất hay, nhưng cứ pick đến 100 trở đi là bị quay về 1. Mình chuyên về nước đôi khi số thứ tự lại vượt 100. Thế là lại dùng phương pháp thủ công DDEDIT. Mong các Pro xửa hộ mình. MÌnh xin cảm ơn.
  • 0
Lần 1: Một hai ba z...ô...zô.
Lần 2: Một hai ba z...ô...zô.
Lần...: Một hai ba z...ô...zô.
Lần 10: Một hai ba "z...a...za".
*************************
Ym! hoai46ctt

#8 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 21 June 2007 - 03:16 PM

Lisp này rất hay, nhưng cứ pick đến 100 trở đi là bị quay về 1. Mình chuyên về nước đôi khi số thứ tự lại vượt 100. Thế là lại dùng phương pháp thủ công DDEDIT. Mong các Pro xửa hộ mình. MÌnh xin cảm ơn.

Bạn dùng mã này:

(defun c:ct ( / ss entp gtlast)
(defun read_text (ent)
(cdr (assoc 1 (entget ent)))
)
(defun write_text (ent gt / tt old new)
(setq tt (entget ent)
old (assoc 1 tt)
new (cons 1 gt)
tt (subst new old tt)
)
(entmod tt)
)
(defun is_number(s)
(wcmatch s "0,1,2,3,4,5,6,7,8,9")
)
(defun is_char(c )
(wcmatch c "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,A,B,C,D,E,F,G,H,I,J,K,L,M
,N,O,P,Q,R,S,T,U,V,W,X,Y,")
)
(defun next_text (str / i)
(cond
((is_number (substr str (strlen str) 1))
(progn
(setq i (strlen str))
(while (and
(> i 1)
(is_number (substr str i 1)))
(setq i (1- i))
)
(strcat (substr str 1 i) (itoa (1+ (atoi (substr str (1+ i))))))
)
)
((is_char (substr str (strlen str) 1))
(progn
(strcat (substr str 1 (1- (strlen str))) (chr (1+ (ascii (substr str (strlen str))))))
)
)
(t str)
)

)
(setq SS (ssget ":S" '((0 . "TEXT"))))
(if ss
(progn
(setq
entp (ssname ss 0)
dgoc (cdr (assoc 10 (entget entp)))
gtlast (read_text entp)
)
(while (setq p (getpoint dgoc "\nVao diem: "))
(command ".copy" ss "" dgoc p)
(setq
entl (entlast)
gtlast (next_text gtlast)
)
(write_text (entlast) gtlast)
)
)
)
(princ)
)

Tên lệnh và cách thức giống hệt lệnh CT cũ nhưng khắc phục được nhược điểm số 100 và chữ Z.
  • 2

#9 vndesperados

vndesperados

    biết lệnh xref

  • Members
  • PipPipPipPipPipPipPip
  • 547 Bài viết
Điểm đánh giá: 253 (khá)

Đã gửi 23 June 2007 - 08:59 AM

Bạn dùng mã này:


(defun c:ct ( / ss entp gtlast)
(defun read_text (ent)
(cdr (assoc 1 (entget ent)))
)
(defun write_text (ent gt / tt old new)
(setq tt (entget ent)
old (assoc 1 tt)
new (cons 1 gt)
tt (subst new old tt)
)
(entmod tt)
)
(defun is_number(s)
(wcmatch s "0,1,2,3,4,5,6,7,8,9")
)
[b](defun is_char(c )
(wcmatch c "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,A,B,C,D,E,F,G,H,I,J,K,L,M

,N,O,P,Q,R,S,T,U,V,W,X,Y,")
)[/b]
(defun next_text (str / i)
(cond
((is_number (substr str (strlen str) 1))
(progn
(setq i (strlen str))
(while (and
(> i 1)
(is_number (substr str i 1)))
(setq i (1- i))
)
(strcat (substr str 1 i) (itoa (1+ (atoi (substr str (1+ i))))))
)
)
((is_char (substr str (strlen str) 1))
(progn
(strcat (substr str 1 (1- (strlen str))) (chr (1+ (ascii (substr str (strlen str))))))
)
)
(t str)
)

)
(setq SS (ssget ":S" '((0 . "TEXT"))))
(if ss
(progn
(setq
entp (ssname ss 0)
dgoc (cdr (assoc 10 (entget entp)))
gtlast (read_text entp)
)
(while (setq p (getpoint dgoc "\nVao diem: "))
(command ".copy" ss "" dgoc p)
(setq
entl (entlast)
gtlast (next_text gtlast)
)
(write_text (entlast) gtlast)
)
)
)
(princ)
)

Tên lệnh và cách thức giống hệt lệnh CT cũ nhưng khắc phục được nhược điểm số 100 và chữ Z.



Bác Hòanh đã check cái này chưa vậy? Bác thử với những số như là 26, 36, 16 chưa? Vì nếu lên đến 29 thì sau đó là 210, 211 (theo mình nghĩ nó sẽ là 30 hoặc 31 chứ)hoặc sau 39 sẽ là 310, 311 (40, 41)
  • 0

#10 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 23 June 2007 - 09:41 AM

Bác Hòanh đã check cái này chưa vậy? Bác thử với những số như là 26, 36, 16 chưa? Vì nếu lên đến 29 thì sau đó là 210, 211 (theo mình nghĩ nó sẽ là 30 hoặc 31 chứ)hoặc sau 39 sẽ là 310, 311 (40, 41)

Cảm ơn vndesperados đã check hộ, lúc viết mình ngồi ở máy nhà người bạn, không có ACAD nên không test được.

đoạn mã trên nhầm ở dòng lệnh (> i 1)
sửa lại thành (> i 0) là sẽ chạy ngon trong mọi trường hợp.
để nguyên (> i 1) sẽ chạy sai trong trường hợp text toàn là số, còn vẫn đúng trong trường hợp text gồm cả số và chữ (ví dụ text có giá trị 'bac 123').
  • 2

#11 sirdo

sirdo

    biết zoom

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

Đã gửi 24 June 2007 - 10:49 PM

[color=#6633FF](defun ketthuc ()
...
Tuy nhiên nếu dùng thì lisp này lại thuận tiện hơn ở 2 điểm:
- thứ nhất: lisp này dùng cho cả A,B,C sử dụng để đánh trục bản vẽ
- thứ hai: chỉ cần đánh lệnh CT rồi chọn đối tượng chuyển đến các chỗ mình cần . Chữ hoặc số bất kỳ sẽ tự động nhảy lên . Ví dụ: khi có một số giá trị là 5, gõ CT bắt 5 chuyển đến các vị trí khác, số thứ tự tự động sẽ là 6,7,8,.... tương tự với khi có một chữ là E, gõ CT bắt E chuyển đến các vị trí khác, chữ thứ tự tự động sẽ là F,G,H,..... Dùng thế này mình đỡ tốn được công đoạn pick lại số đã copy, hỏi số bắt đầu mà gói gọn hết lại thành duy nhất một công đoạn copy thôi . Các bạn thử dùng xem sao .


Cái này hay quá, nhưng mà sao không dùng cho text dạng: Kt-01 -> Kt-02... Vậy?
Tớ muốn đánh số kiểu như: Kt-01 -> kt-02.... tự động thì làm thế nào? Thanks!
  • 0

#12 tambat

tambat

    biết zoom

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

Đã gửi 25 June 2007 - 12:26 PM

Bác Hoanh ơi ! Lisp này rất hay nhưng thường trong ký hiệu của các trục thì chúng ta không thường cho phần chữ hay số đó nằm trong vòng tròn hay một khung nào đó tùy thích, vậy bác có thể chỉnh sửa lại nó làm sao để làm được điều này hay không ?.
ví dụ mình đã có sẵn các vòng tròn định sẵn (tại các vị trí cần đánh số thứ thự) kết quả của lisp đánh số thứ tự đó thì phần chữ nó nằm ngay chính giữa của vòng tròn (hay khung) sẵn có. (đối với vòng tròn, trong quá trình vao diem minh bat điềm bằng "center".

Hay bác có thể hoàn thiện luôn tùy chọn khung bao (vòng tròn hay khung nào đó mà thông dụng trong quá trình ghi trục ...) ! Minh ham quá rùi phải không bác, mong bác đùng trách nhé, cũng chỉ vì minh không biết gì cả nên xin hoi bác maaaaaaaaaaaaaà
  • 0

#13 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 25 June 2007 - 01:08 PM

Bác Hoanh ơi ! Lisp này rất hay nhưng thường trong ký hiệu của các trục thì chúng ta không thường cho phần chữ hay số đó nằm trong vòng tròn hay một khung nào đó tùy thích, vậy bác có thể chỉnh sửa lại nó làm sao để làm được điều này hay không ?.
ví dụ mình đã có sẵn các vòng tròn định sẵn (tại các vị trí cần đánh số thứ thự) kết quả của lisp đánh số thứ tự đó thì phần chữ nó nằm ngay chính giữa của vòng tròn (hay khung) sẵn có. (đối với vòng tròn, trong quá trình vao diem minh bat điềm bằng "center".

Hay bác có thể hoàn thiện luôn tùy chọn khung bao (vòng tròn hay khung nào đó mà thông dụng trong quá trình ghi trục ...) ! Minh ham quá rùi phải không bác, mong bác đùng trách nhé, cũng chỉ vì minh không biết gì cả nên xin hoi bác maaaaaaaaaaaaaà

Bạn hãy làm ngược lại!
Tức là bạn viết text bằng lệnh trên, xong rồi mới vẽ hình tròn.
Lệnh vẽ hình tròn quanh 1 đối tượng text là TCIRCLE (trong bộ Express của CAD).
Như thế, khi vẽ ở máy nào bạn cũng làm được.
  • 0

#14 vndesperados

vndesperados

    biết lệnh xref

  • Members
  • PipPipPipPipPipPipPip
  • 547 Bài viết
Điểm đánh giá: 253 (khá)

Đã gửi 26 June 2007 - 04:04 PM

Cái này hay quá, nhưng mà sao không dùng cho text dạng: Kt-01 -> Kt-02... Vậy?
Tớ muốn đánh số kiểu như: Kt-01 -> kt-02.... tự động thì làm thế nào? Thanks!


http://www.cadviet.com/upfiles/SDS.zip

Cái này hơi khác với mấy cái trên nhưng mà đúng ý bạn đó
Lưu ý: Trên bản vẽ phải có ít nhất một style có chiều cao chữ > 0
  • 0

#15 tambat

tambat

    biết zoom

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

Đã gửi 27 June 2007 - 12:42 PM

Bạn hãy làm ngược lại!
Tức là bạn viết text bằng lệnh trên, xong rồi mới vẽ hình tròn.
Lệnh vẽ hình tròn quanh 1 đối tượng text là TCIRCLE (trong bộ Express của CAD).
Như thế, khi vẽ ở máy nào bạn cũng làm được.


làm như thế thì vòng tròn đó không đều nhau vì số thứ tự đánh ra là 1, 2 ..., 10, 10 chứ không phải là 01, 02, ..., 10 ..., chúng ta chỉ có thể offset nó thối. hơn nữa phần đánh số (chữ) theo thư tự này thường dùng vào đánh cho ký hiệu các trục, khi đó nó phải nằm gay chính giữa. bác có thể sữa lại sao cho khi chúng ta vào điểm thì điểm đó sẽ là tâm của text (MC).

Biết là lisp này rất bổ ích, giúp rút ngắn thời gian vẽ rất nhiều nếu trong bản vẽ cần phải đánh thứ tự nhiều, song nếu các bác có thể thêm được phần tự vẽ luôn vòng tròn hay ký hiệu trục thông dụng thì tính hiệu dụng của lisp nay sẽ không dừng lại ở mức hiện nay.

Chúc các bác sức khỏe dồi dào để trào ra lisp
  • 0

#16 ngagau

ngagau

    biết pan

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

Đã gửi 27 June 2007 - 02:08 PM

http://www.cadviet.com/upfiles/SDS.zip

Cái này hơi khác với mấy cái trên nhưng mà đúng ý bạn đó
Lưu ý: Trên bản vẽ phải có ít nhất một style có chiều cao chữ > 0

làm theo cách trên là hay vừa chiến text được vừa số được ... chỉ việc pick và pick thế thôi ...
  • 0

#17 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 27 June 2007 - 02:37 PM

làm như thế thì vòng tròn đó không đều nhau vì số thứ tự đánh ra là 1, 2 ..., 10, 10 chứ không phải là 01, 02, ..., 10 ..., chúng ta chỉ có thể offset nó thối. hơn nữa phần đánh số (chữ) theo thư tự này thường dùng vào đánh cho ký hiệu các trục, khi đó nó phải nằm gay chính giữa. bác có thể sữa lại sao cho khi chúng ta vào điểm thì điểm đó sẽ là tâm của text (MC).

Bạn hãy thử dùng lệnh TCOUNT đi đã!
- Lệnh này cho phép các đường tròn có bán kính bằng nhau, không quan trọng chiều dài của chữ.
- Lệnh này sẽ căn tâm hình tròn vào tâm của chữ (không phải điểm chèn). Nên chữ sẽ cân đối trong vòng tròn.

Hai mối lo ngại của bạn là ảo đấy!
  • 0

#18 nvc

nvc

    biết pan

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

Đã gửi 04 May 2009 - 02:49 AM

Bạn hãy thử dùng lệnh TCOUNT đi đã!
- Lệnh này cho phép các đường tròn có bán kính bằng nhau, không quan trọng chiều dài của chữ.
- Lệnh này sẽ căn tâm hình tròn vào tâm của chữ (không phải điểm chèn). Nên chữ sẽ cân đối trong vòng tròn.

Hai mối lo ngại của bạn là ảo đấy!



Bạn sang đây xem nhé.
http://www.cadviet.c...?showtopic=7786
  • 0

#19 tamhonda_8x

tamhonda_8x

    Chưa sử dụng CAD

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

Đã gửi 20 October 2009 - 08:45 AM

(defun ketthuc ()
(setvar "cmdecho" luuecho)
(setq *error* luu
luu nil
luuecho nil
);setq
(princ "\nThe la het")
(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:ct ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(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))
)
)
);
(if (/= textxl nil)
(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
);if
(ketthuc)
);defun

;Note: bien toan cuc: textxl vitrilech


Đây cũng là một lisp dùng cho việc đánh số thứ tự bậc thang hoặc trục bao gồm cả số lẫn chữ nhưng dài dòng hơn lisp của Nguyen Hoanh . Tuy nhiên nếu dùng thì lisp này lại thuận tiện hơn ở 2 điểm:
- thứ nhất: lisp này dùng cho cả A,B,C sử dụng để đánh trục bản vẽ
- thứ hai: chỉ cần đánh lệnh CT rồi chọn đối tượng chuyển đến các chỗ mình cần . Chữ hoặc số bất kỳ sẽ tự động nhảy lên . Ví dụ: khi có một số giá trị là 5, gõ CT bắt 5 chuyển đến các vị trí khác, số thứ tự tự động sẽ là 6,7,8,.... tương tự với khi có một chữ là E, gõ CT bắt E chuyển đến các vị trí khác, chữ thứ tự tự động sẽ là F,G,H,..... Dùng thế này mình đỡ tốn được công đoạn pick lại số đã copy, hỏi số bắt đầu mà gói gọn hết lại thành duy nhất một công đoạn copy thôi . Các bạn thử dùng xem sao .

===================================
cảm ơn bạn rât nhiều nhưng cho mình hỏi, mình làm với text font chữ là txt thì đưọc, nhưng với các font chứ khác thì toàn bị lỗi font như : 1~. 1&...
mong bạn giúp đỡ
  • 0

#20 gnutirt

gnutirt

    Chưa sử dụng CAD

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

Đã gửi 29 January 2010 - 10:44 AM

http://www.cadviet.com/upfiles/SDS.zip

Cái này hơi khác với mấy cái trên nhưng mà đúng ý bạn đó
Lưu ý: Trên bản vẽ phải có ít nhất một style có chiều cao chữ > 0

minh test SDS của bác vndesperdos thì thi nhấn 1 điểm bất kỳ để kết thúc chương sau khi thực hiện xong cái thiết lập bị 1 error "Requires numeric distance or second point." hix, ai test thử chỉ giáo mình với
  • -1