Đến nội dung


Hình ảnh

lít copy tăng dần cop đến hàng nghìn cũng OK


  • Please log in to reply
18 replies to this topic

#1 oizdoi_oi

oizdoi_oi

    biết dimlinear

  • Members
  • PipPipPipPipPip
  • 306 Bài viết
Điểm đánh giá: 452 (tốt)

Đã gửi 01 October 2008 - 03:07 PM

lít copy tăng dần cop đến hàng nghìn cũng OK, không bit lit này cổ chưa nhưng vẫn pos
nếu ai chưa có thank một tiếng động viên cái!
 (defun C:CT (/ name_op num_op_chon point_base_st point_new_st num_ op_tang 
op_tang_new last_ch cong_val)
(setq old_ts_err *error*)
(setvar "Cmdecho" 0)
(if(= cong_vao NIL)(setq cong_vao 1))
(Prompt "\n Neu tham so < 0 --> ket qua giam ! ")
(setq cong_val(getint(strcat "\n Tham so tang /<" (itoa cong_vao)">: ") ))
(if(= cong_val NIL)(setq cong_val cong_vao)(setq cong_vao cong_val))
(Prompt "\n Chon doi tuong tang: ")
(if(and cong_vao (setq op_tang(ssget)))
(progn
(setq num_op_chon(sslength op_tang)
num_ 0
op_tang_new NIL)
(if(setq point_base_st(getpoint "\n > Diem goc: "))
(while
(setq point_new_st(getpoint "\n >> Diem dat tiep theo: " point_base_st))
(if op_tang_new (setq op_tang op_tang_new op_tang_new NIL))
(setq num_op_chon(sslength op_tang) op_tang_new(ssadd))
(if(and point_base_st point_new_st)
(progn
(repeat num_op_chon
(progn
(setq name_op(ssname op_tang num_))
(command "_.Copy" name_op "" point_base_st point_new_st)
(setq last_ch(entlast)
op_tang_new(ssadd last_ch op_tang_new))
(process)
(setq num_ (+ 1 num_))
(if(= num_ num_op_chon)(setq num_ 0))
)
)
)
);if
(setq point_base_st point_new_st)
));if while
);progn
);if
(setq *error* old_ts_err)
(princ)
);End Tang.
(defun process (/ name_check text_value dat_up dat_style num_value new_value)
(progn
(setq name_check(assoc 0 (setq dat_up (entget last_ch))) )
(if(or(= (cdr name_check) "TEXT")
(= (cdr name_check) "MTEXT"))
(progn
(setq text_value(assoc 1 dat_up))
(if(= (distof (cdr text_value) 2) NIL)
(setq dat_style "Text")
(setq dat_style "Num" num_value (atof (cdr text_value)) )
)
(cond
((= dat_style "Num")
(setq new_value (itoa (fix(+ num_value cong_vao))) ))
((= dat_style "Text")
(setq new_value(chr (+ (ascii (cdr text_value)) cong_vao))) )
)
(setq dat_up(subst (cons '1 new_value) text_value dat_up) )
(entmod dat_up)
);progn
);if
(setq name_op NIL)
);progn
);Process.

  • 3
KTS không bao giờ chết đói...mà chỉ đói đến lúc chết!

#2 Ar_Chanwoo

Ar_Chanwoo

    biết lệnh break

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

Đã gửi 01 October 2008 - 06:08 PM

lít copy tăng dần cop đến hàng nghìn cũng OK, không bit lit này cổ chưa nhưng vẫn pos
nếu ai chưa có thank một tiếng động viên cái!
http://www.cadviet.c...copytangdan.lsp

Lisp này có 1 cái hay là khi copy có thể select thêm đối tượng, tuy nhiên khi copy theo đường xiên ( tắt F8) thì bị lỗi Text không nằm vào giữa đường tròn.
  • 0

#3 oizdoi_oi

oizdoi_oi

    biết dimlinear

  • Members
  • PipPipPipPipPip
  • 306 Bài viết
Điểm đánh giá: 452 (tốt)

Đã gửi 02 October 2008 - 09:26 AM

Lisp này có 1 cái hay là khi copy có thể select thêm đối tượng, tuy nhiên khi copy theo đường xiên ( tắt F8) thì bị lỗi Text không nằm vào giữa đường tròn.

mình sử dụngvẫn bình thường mà, tại bạn chưa để căn chữ middle thôi mà, bạn xem lại nhéHình đã gửi
  • 0
KTS không bao giờ chết đói...mà chỉ đói đến lúc chết!

#4 Ar_Chanwoo

Ar_Chanwoo

    biết lệnh break

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

Đã gửi 02 October 2008 - 03:19 PM

mình sử dụngvẫn bình thường mà, tại bạn chưa để căn chữ middle thôi mà, bạn xem lại nhéHình đã gửi

OK ! Thanks
  • 1

#5 hoai46ctt

hoai46ctt

    biết vẽ spline

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

Đã gửi 07 October 2008 - 08:45 AM

OK ! Thanks

Cho mình Thanks một phát :cheers:
  • 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

#6 Đặng Vũ Hiệp

Đặng Vũ Hiệp

    biết lệnh linetype

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

Đã gửi 10 November 2008 - 04:24 PM

lít copy tăng dần cop đến hàng nghìn cũng OK, không bit lit này cổ chưa nhưng vẫn pos
nếu ai chưa có thank một tiếng động viên cái!
http://www.cadviet.c...copytangdan.lsp


Tên của lệnh này là gì vậy bạn. Mình vẽ cad, sử dụng lips nhiều nhưng không biết tý tẹo gì về viết lips hết. Buồn....
  • 1
Nước biển mênh mông không đong đầy tình mẹ
Mây trời lồng lộng không phủ kín công cha...

#7 oizdoi_oi

oizdoi_oi

    biết dimlinear

  • Members
  • PipPipPipPipPip
  • 306 Bài viết
Điểm đánh giá: 452 (tốt)

Đã gửi 10 November 2008 - 05:01 PM

Tên của lệnh này là gì vậy bạn. Mình vẽ cad, sử dụng lips nhiều nhưng không biết tý tẹo gì về viết lips hết. Buồn....

La CT ban a, neu llist nao bankhong bit thi ban cứ nháy đúp mở file đó ra sẽ nhìn thấy tên lệnh
  • 0
KTS không bao giờ chết đói...mà chỉ đói đến lúc chết!

#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 10 November 2008 - 05:07 PM

Tên của lệnh này là gì vậy bạn. Mình vẽ cad, sử dụng lips nhiều nhưng không biết tý tẹo gì về viết lips hết. Buồn....

* Để biết tên lệnh là gì?
Bạn mở file lsp ra, tìm đến các dòng mã (defun c:, phía sau c: là tên lệnh. Ví dụ: (defun c:CT thì tên lệnh là CT.
Bạn xem ở đây: Hướng dẫn sử dụng mã lisp
  • 0

#9 Đặng Vũ Hiệp

Đặng Vũ Hiệp

    biết lệnh linetype

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

Đã gửi 10 November 2008 - 05:35 PM

a mình hiểu rùi. Hi hi người thông mình mà nói thế là hiểu. He he he. Nói vui thôi...
  • 0
Nước biển mênh mông không đong đầy tình mẹ
Mây trời lồng lộng không phủ kín công cha...

#10 Updatelisp

Updatelisp

    biết vẽ pline

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

Đã gửi 11 November 2008 - 10:49 AM

lít copy tăng dần cop đến hàng nghìn cũng OK, không bit lit này cổ chưa nhưng vẫn pos
nếu ai chưa có thank một tiếng động viên cái!
http://www.cadviet.c...copytangdan.lsp

các bạn có thể tham khảo ở đây :http://www.cadviet.com/upfiles/cv.lsp
  • 0
Thân Z707!
Không nên hiểu và cũng không nên,không nên hiểu!

#11 tuoichuot84

tuoichuot84

    biết vẽ ellipse

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

Đã gửi 11 November 2008 - 11:06 AM

Hay quá! Thanks bác!
  • 0

#12 KIM5K

KIM5K

    biết pan

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

Đã gửi 13 November 2008 - 10:50 AM

[quote name='oizdoi_oi' date='Oct 2 2008, 9:26' post='35420']
mình sử dụngvẫn bình thường mà, tại bạn chưa để căn chữ middle thôi mà, bạn xem lại nhéHình đã gửi
[/quotéao em lam no ko tăng ma cứ 1 ..1..1. bước đều vậy
  • 0

#13 oizdoi_oi

oizdoi_oi

    biết dimlinear

  • Members
  • PipPipPipPipPip
  • 306 Bài viết
Điểm đánh giá: 452 (tốt)

Đã gửi 24 November 2008 - 01:40 PM

bạn dùng đúng tên lệnh chưa?
  • 0
KTS không bao giờ chết đói...mà chỉ đói đến lúc chết!

#14 tuanlongtl

tuanlongtl

    biết vẽ arc

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

Đã gửi 24 November 2008 - 02:09 PM

các bạn có thể tham khảo ở đây :http://www.cadviet.com/upfiles/cv.lsp

Tăng dần theo kiểu này thì không đwợc. VD copy tăng dần c199, c200, c201 dùng lenh cv thì sẽ thành c21, c22, c23; nếu dùng lệnh ct thì sẽ thành d, e, f. Có cách nào khắc phục không vậy bạn
  • 0

#15 tuanlongtl

tuanlongtl

    biết vẽ arc

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

Đã gửi 24 November 2008 - 02:36 PM

Tăng dần theo kiểu này thì không đwợc. VD copy tăng dần c199, c200, c201 dùng lenh cv thì sẽ thành c21, c22, c23; nếu dùng lệnh ct thì sẽ thành d, e, f. Có cách nào khắc phục không vậy bạn

Vừa hỏi xong thì tìm được đoạn code sau

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

dùng rất oke
  • 0

#16 thaibinhan

thaibinhan

    Chưa sử dụng CAD

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

Đã gửi 16 February 2009 - 10:45 PM

Bạn có thể hướng dẫn cụ thể hơn được không!!! Mình cũng làm thử nhưng sau khi gõ lệnh DSC thì hiện lên dòng chữ:"Hay lua chon so ma ban muon copy :"và sau đó thì không làm được nữa.Pó tay.Mong bạn giúp đỡ.Thanks.
  • 0

#17 tatubn

tatubn

    Chưa sử dụng CAD

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

Đã gửi 22 April 2011 - 05:13 PM

Tăng dần theo kiểu này thì không đwợc. VD copy tăng dần c199, c200, c201 dùng lenh cv thì sẽ thành c21, c22, c23; nếu dùng lệnh ct thì sẽ thành d, e, f. Có cách nào khắc phục không vậy bạn

mình chia sẻ bạn chút nhé, mình cũng cần làm tương tự bạn nên ban đầu mình để text c199, c200... thành 999199, 999200... như vậy dùng lisp trên là hoàn toàn hợp lý. Sau đó lyiso phần text đó, sửa 999 thành c bằng lệnh find. Như vậy cũng tiện hơn nhiều rồi
  • 0

#18 Quang Duc Ha

Quang Duc Ha

    biết vẽ pline

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

Đã gửi 22 April 2011 - 08:22 PM

Mình tìm mãi không thấy nút Thanks đâu để thanks bạn một cái nhỉ! Hay đấy, bây giờ mình mới biết.
  • 0

#19 tinya1225

tinya1225

    biết lệnh copy

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

Đã gửi 04 May 2011 - 02:08 PM

lít copy tăng dần cop đến hàng nghìn cũng OK, không bit lit này cổ chưa nhưng vẫn pos
nếu ai chưa có thank một tiếng động viên cái!

 (defun C:CT (/ name_op num_op_chon point_base_st point_new_st num_ op_tang 
op_tang_new last_ch cong_val)
(setq old_ts_err *error*)
(setvar "Cmdecho" 0)
(if(= cong_vao NIL)(setq cong_vao 1))
(Prompt "\n Neu tham so < 0 --> ket qua giam ! ")
(setq cong_val(getint(strcat "\n Tham so tang /<" (itoa cong_vao)">: ") ))
(if(= cong_val NIL)(setq cong_val cong_vao)(setq cong_vao cong_val))
(Prompt "\n Chon doi tuong tang: ")
(if(and cong_vao (setq op_tang(ssget)))
(progn
(setq num_op_chon(sslength op_tang)
num_ 0
op_tang_new NIL)
(if(setq point_base_st(getpoint "\n > Diem goc: "))
(while
(setq point_new_st(getpoint "\n >> Diem dat tiep theo: " point_base_st))
(if op_tang_new (setq op_tang op_tang_new op_tang_new NIL))
(setq num_op_chon(sslength op_tang) op_tang_new(ssadd))
(if(and point_base_st point_new_st)
(progn
(repeat num_op_chon
(progn
(setq name_op(ssname op_tang num_))
(command "_.Copy" name_op "" point_base_st point_new_st)
(setq last_ch(entlast)
op_tang_new(ssadd last_ch op_tang_new))
(process)
(setq num_ (+ 1 num_))
(if(= num_ num_op_chon)(setq num_ 0))
)
)
)
);if
(setq point_base_st point_new_st)
));if while
);progn
);if
(setq *error* old_ts_err)
(princ)
);End Tang.
(defun process (/ name_check text_value dat_up dat_style num_value new_value)
(progn
(setq name_check(assoc 0 (setq dat_up (entget last_ch))) )
(if(or(= (cdr name_check) "TEXT")
(= (cdr name_check) "MTEXT"))
(progn
(setq text_value(assoc 1 dat_up))
(if(= (distof (cdr text_value) 2) NIL)
(setq dat_style "Text")
(setq dat_style "Num" num_value (atof (cdr text_value)) )
)
(cond
((= dat_style "Num")
(setq new_value (itoa (fix(+ num_value cong_vao))) ))
((= dat_style "Text")
(setq new_value(chr (+ (ascii (cdr text_value)) cong_vao))) )
)
(setq dat_up(subst (cons '1 new_value) text_value dat_up) )
(entmod dat_up)
);progn
);if
(setq name_op NIL)
);progn
);Process.

lisp này có lâu rùi mà. dù sao vẫn thanks bạn rùi đó^^
  • 0
Thấy bài có ích thì ấn thật nhiều Thank + các bác nhé^^