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.
Ngocnguyenn

Nhờ các cao thủ sửa giùm mình lisp này nha!

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

Ngocnguyenn    2
(defun c:TG ()

 (setq olderr *error* *error* myerror)

 (prompt "\nChon cac text so hoac Dim can tinh tong")

 (setq SS (ssget))

 (setq TONG 0)

 (if SS 

  (progn

   (setq N (sslength SS) M 0 L 0)

   (repeat N

    (setq S (entget (ssname SS M)))

    (setq V0 (cdr (assoc 0 S)))    

    (if (= V0 "TEXT")

     (progn

      (setq VALUE (cdr (assoc 1 S)))

      (if (numberp (distof VALUE))

       (progn

        (setq DT (atof VALUE))

        (setq TONG (+ TONG DT))

        (setq L (1+ L))

       )

      )

     )

     (if (or (= V0 "DIMENSION") (= V0 "ARC_DIMENSION"))

      (progn  

       (setq V1 (read (cdr (assoc 1 S))))

       (setq V42 (cdr (assoc 42 S)))

       (if (numberp V1) (setq TONG (+ TONG V1))

        (progn 

         (if (/= V42 -1.0) (setq TONG (+ TONG V42))

          (progn

           (setq PT10  (cdr (assoc 10 S)))

           (setq PT13  (cdr (assoc 13 S)))

           (setq PT14  (cdr (assoc 14 S)))

           (setq ANG1  (angle PT14 PT10))

           (setq PT13I (polar PT13 ANG1 2))

           (setq ANG2  (+ ANG1 (/ PI 2)))

           (setq PT14I (polar PT14 ANG2 2))

           (setq PT13N (inters PT13 PT13I PT14 PT14I nil))  

           (setq DS    (distance PT13N PT14))

           (setq DSTY  (cdr (assoc 3 S)))

           (setq DSC   (cdr (assoc 144 (tblsearch "DIMSTYLE" DSTY))))

           (setq VALUE (* DS DSC))

           (if (/= nil VALUE) (setq TONG (+ TONG VALUE)))

          )

         )

        )

       )

       (setq L (1+ L))

      )

     )

    )

    (setq M (+ 1 M))

   )

   (princ TONG)

   (princ "/")

   (princ L)

   (princ "=")

   (princ (/ TONG L))

   (princ)

   (setq TOTB (getstring "\nTinh Tong/trung Binh (T/B):<T> "))

   (if (= TOTB "") (setq TOTB "T") (setq TOTB (strcase TOTB)))

   (setq GIATRI (entget (car (entsel "\nChon text de gan gia tri"))))

   (setq GIA (assoc 1 GIATRI))

   (if (= TOTB "T") 

    (setq NT1 (cons 1 (rtos TONG)))

    (setq NT1 (cons 1 (rtos (/ TONG L))))

   )

   (setq GIATRI (subst NT1 GIA GIATRI))

   (entmod GIATRI)

   (princ)

  )

 )

)

 

Đây bạn ơi... bạn sửa cách xuất kết quả giùm mình nhé! 

  • 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


×