Chuyển đến nội dung
Diễn đàn CADViet
oizdoi_oi

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

Bởi oizdoi_oi , trong Sử dụng AutoCAD

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

oizdoi_oi    451

oizdoi_oi
Đã đăng

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.

  • Vote tăng 3

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

Ar_Chanwoo    39

Ar_Chanwoo
Đã đăng
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.com/upfiles/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.

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

oizdoi_oi    451

oizdoi_oi
Đã đăng
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éuntitled2_3.jpg

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

hoai46ctt    33

hoai46ctt
Đã đăng
OK ! Thanks

Cho mình Thanks một phát :cheers:

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

Đặng Vũ Hiệp    104

Đặng Vũ Hiệp
Đã đăng
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.com/upfiles/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....

  • Vote tăng 1

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

oizdoi_oi    451

oizdoi_oi
Đã đăng
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

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

Tue_NV    3.912

Tue_NV
Đã đăng
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

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

Updatelisp    8

Updatelisp
Đã đăng
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.com/upfiles/copytangdan.lsp

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

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

KIM5K    0

KIM5K
Đã đăng

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éuntitled2_3.jpg

[/quotéao em lam no ko tăng ma cứ 1 ..1..1. bước đều vậy

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

tuanlongtl    5

tuanlongtl
Đã đăng
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

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

tuanlongtl    5

tuanlongtl
Đã đăng
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

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

thaibinhan    0

thaibinhan
Đã đăng

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.

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

tatubn    0

tatubn
Đã đăng

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

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

tinya1225    36

tinya1225
Đã đăng

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 đó^^

  • Vote tăng 1
  • Vote giảm 1

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
Về Đầu Trang Sử dụng AutoCAD
×