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  
nk_long

Có người xin Lisp tinh tổng dài, vô đây nè!

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

nk_long    14

(defun sort_num (LLLL / LLLL nLLL sort_order flag1 )

(repeat (length LLLL)

(setq sort_order

(append sort_order (list

(apply 'min LLLL)

) ) )

(setq flag1 nil)

(foreach x LLLL

 

(if (or (not (= x (apply 'min LLLL)))

flag1

)

 

(setq nlll (append nlll (list x)) )

(setq flag1 1)

);if

 

);foreach

 

(setq llll nlll

nlll nil )

);repeat

(setq sort_order sort_order)

)(princ)

;=============================

;Ham lay chieu dai cua mot doi tuong

(defun addlen(eset / en enlist entype len tong_len cntr)

(setvar "cmdecho" 0)

(defun getArc(en)

(command "lengthen" en "")

(getvar "perimeter")

)

(defun getLine(en)

(setq enlist(entget en))

(distance (cdr(assoc 10 enlist)) (cdr(assoc 11 enlist)))

)

(defun getPoly(en)

(command "area" "Object" en)

(getvar "perimeter")

)

(setq tong_len 0)

(setq cntr 0)

(while (< cntr (sslength eset))

(setq en (ssname eset cntr))

(setq enlist (entget en))

(setq enType (cdr (assoc 0 enlist)))

(cond

((= enType "ARC" )(setq len(getArc en)))

((= enType "CIRCLE" )(setq len(getPoly en)))

((= enType "ELLIPSE" )(setq len(getPoly en)))

((= enType "LINE" )(setq len(getLine en)))

((= enType "LWPOLYLINE")(setq len(getPoly en)))

((= enType "POLYLINE" )(setq len(getPoly en)))

((= enType "SPLINE" )(setq len(getPoly en)))

(T (setq len 0.0))

)

(while (< (strlen enType) 12) (setq enType (strcat enType " ")))

(setq tong_len (+ tong_len len))

(setq cntr (+ cntr 1))

)

(setvar "cmdecho" 1)

(setq totallen tong_len)

(princ)

)

;==========================

;xuat file

(defun c:len2file(/ ss l i f tf)

(setq ss (ssget))

(setq tf (getstring "\nTên t\U+1EADp tin d\U+1EEF li\U+1EC7u: "))

(setq tf (strcat (getvar "DWGPREFIX") tf ".txt"))

(setq dlist '())

(setq l (sslength ss))

(setq i 0)

(while (< i l)

(setq ssi (ssadd (ssname ss i)))

(addlen ssi)

(setq dai totallen)

(setq dlist (append dlist (list dai)))

(setq i (+ 1 i))

 

)

 

(setq dlist (sort_num dlist)); ko sap xep bo dong nay

 

 

 

(setq f (open tf "a"))

 

(while (/= dlist nil)

(setq daix (car dlist))

(write-line (rtos daix 2 3) f)

(setq dlist (cdr dlist))

 

)

(close f)

)

 

(defun c:l2f() (c:len2file) (princ) (princ))

 

(defun c:l2t()

(setq sh1 (ssget))

(addlen sh1)

(setq ll totallen)

(setq elst (entget (car (entsel "\n\U+0110i\U+1EC1n k\U+1EBFt qu\U+1EA3 vào: "))))

(setq shanu (rtos ll 2 3))

(setq elst (subst (cons 1 shanu) (assoc 1 elst) elst))

(entmod elst)

(princ)

(princ)

)

;==============================================================================

 

 

Đoạn Code này có 2 lệnh: l2f và l2t

Các cô các Bác chọn tuỳ thích đối tượng trên bản vẻ, miễn là đối tượng có chiều dài thì nó tính ra tất.

l2f: nó sẽ xuất ra file dạng text, file nằm ở cùng thư mục với bản vẻ hiện hữu.

Nó tự sắp xếp theo thứ tự tăng dần. Cô bác nào muốn nó kô tự sắp xếp lại thì bỏ dòng: (setq dlist (sort_num dlist)) đi.

 

l2t: lấy tổng chiều dài của một nhóm đối tượng rồi ghi vào một text có sẳn trên bản vẻ.

 

Dùng các bản CAD có hổ trợ Unicode ở dòng command có tiếng Việt hẳn hòi.( Chắc là CAD2005 trở đi)

 

Chúc mọi người công việc thuận lợi!!!!!!!!!!!!

  • 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

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  

×