Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
namtrantt206xd

Nhờ Các Bác Sửa Giúp Em Lisp Này Với

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

Em có download trên diễn đàn lisp tính tổng các đường Line và Polyline:http://www.cadviet.com/upfiles/6/89361_tg.lsp

Em muốn sửa Lisp này như sau:

1. Làm tròn 2 số sau dấu phẩy của các đường Line và Polyline trước khi cộng tổng lại

2. Đổi text sang màu 6

Nhờ các bác giúp em với.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/3778-lisp-tinh-tong-chieu-dai-cac-line-hay-pline/
(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:tg (/ tot_len ss e_name e_record e_type)
(princ "\nCADViet.com © 2007")
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(princ)
)
(princ "\ntg - free lisp from www.cadviet.com")
(princ)

  • 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

Thay (getvar "PERIMETER") bằng (atof (rtos (getvar "PERIMETER") 2 2))

 

Còn đổi màu chữ thì có câu lệnh nào chèn text đâu mà đổ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

Thay (getvar "PERIMETER") bằng (atof (rtos (getvar "PERIMETER") 2 2))

 

Còn đổi màu chữ thì có câu lệnh nào chèn text đâu mà đổi ?

Thanks bác nhiều nhé. Nhân tiện bác sửa giúp em cách đổi màu TEXT trong đoạn code sau luôn:

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/3778-lisp-tinh-tong-chieu-dai-cac-line-hay-pline/

(defun add_mline ()

(foreach e_record_sub e_record

(cond ((= 10 (car e_record_sub))

(setq pt1 (cdr e_record_sub)

mline_len 0.0

)

)

((= 11 (car e_record_sub))

(setq pt2 (cdr e_record_sub)

mline_len (+ mline_len (distance pt2 pt1))

pt1 pt2

)

)

)

)

(setq tot_len (+ tot_len mline_len))

(ssdel e_name ss)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:tg (/ tot_len ss e_name e_record e_type)

(princ "\nCADViet.com © 2007")

(setq tot_len 0.0)

(setq ss (ssget))

(if (null ss)

(exit)

)

(while (> (sslength ss) 0)

(setq e_name (ssname ss 0))

(setq e_record (entget e_name))

(setq e_type (cdr (assoc '0 e_record)))

(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")

(command "lengthen" e_name "")

(setq tot_len (+ tot_len (atof (rtos (getvar "PERIMETER") 2 2))))

(ssdel e_name ss)

)

((wcmatch e_type "MLINE") (add_mline))

(e_type (ssdel e_name ss))

)

)

(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))

(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))   (setq elst (entget en))

  (setq elst (subst (cons 1 (strcat " " (rtos dtl 2 2))) (assoc 1 elst) elst))

  (setq elst (append elst '((62 . 6))))

  (prin1 elst)

  (entmod elst)

;  (print)

;  (prompt (strcat "\nTotal area : " (rtos dTy_le 2 4)))

;  (print)

;  (setq pt2 (getpoint "\nPoint to write: "))

;  (command "text" pt2 "" "0" (rtos dtl 2 2))

);defun

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

Đọc đến cuối đoạn lisp của bác mà em tí thì sặc nước  :D  :D

Bác copy đoạn lisp ở đâu thêm vào thế này ko chạy được đâu.

Đây, gửi lại lisp cho bác.

 

http://www.cadviet.com/upfiles/6/124641_tgtext_1.lsp

  • 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

Đọc đến cuối đoạn lisp của bác mà em tí thì sặc nước  :D  :D

Bác copy đoạn lisp ở đâu thêm vào thế này ko chạy được đâu.

Đây, gửi lại lisp cho bác.

 

http://www.cadviet.com/upfiles/6/124641_tgtext_1.lsp

Cảm ơn bạn nhiều nhé. tại không hiểu bản chất nên mới copy dán lung tung xem nó có được không.

Lisp bạn sửa giúp mình được rồi nhưng nhờ bạn sửa thêm cho 1 tí nữa là:

1. sau khi chọn Text là gán kết quả luôn không cần phải ấn enter thêm.

2. Text luôn trả về 2 số sau dấu phẩy. ví dụ kết quả là 0.80 thay vì như hiện tại là 0.8

Thanks bạn nhiều nhé!

  • 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

Anh @QuocManh giải đáp thắc mắc giùm.

Sử dụng biến Dimzin thấy khác biệt rõ giá trị:   0.....không Trim số "0" đằng sau.  8..... Trim sạch mấy số 0 sau text.

Còn các giá trị khác như 1, 2 ,..... 9 thì sao nhỉ . Em chưa hiểu rõ cách xài cho lắm.  Nhưng cũng hiểu lỗi tại sao lại 0.8 với 0.80 rồi  :D

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

Cảm ơn bác nhé. Nhưng sao em tải Lisp của bác về không dùng được nhỉ?

 

Câu hỏi thì dễ, nhưng câu trả lời thì khó quá!

CAD nó báo thế nào? F2 chụp hình gửi lên thì mới chẩn đoán lâm sàng được chứ!

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

Sửa lại theo sở thích của bạn đây : Bạn xem ổn chưa. Lệnh "tgg".

 

Thank a #QuocManh đã giải đáp thắc mắc  :D  :D

 

http://www.cadviet.com/upfiles/6/124641_tgg_1.lsp

Quá tuyệt vời. Đúng như mình muốn. Cảm ơn bạn rất nhiều 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

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  

×