Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
ptd1987

Nhờ các bác chỉnh dùm lisp ghi diện tích này dùm em

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

 Nhờ các bác chỉnh dùm lisp ghi diện tích này dùm em:

1) Mặc định tỉ lệ bản vẽ là 0.001

2) Mặc định chiều cao chữ là 250

3) Hoặc ghi nhớ lần nhập trc đó

Em phải đo diện tích này nhiều mà mỗi lần phải đánh số 0.001 và 250 tốn thao tác + thời gian quá, Xin cám ơn trc ^.^

(defun c:ddt(/ lacol ladin laos tl h tl1 cao1 k tdt ss pt p1 p2 p3 p4 p5 p6 p7 p8
                        pa pt1 pt2 e ep p9 p10 p11 p12 p13 et dtcon )
  (setvar "cmdecho" 0)
  (setq lacol (getvar "CEColor"))
  (setq ladin (getvar "dimzin"))
  (setq laos (getvar "osmode"))  
  (if (not tl) (setq tl 1))
  (if (not h) (setq h 1))
  (setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))
  (if tl1 (setq tl tl1))
  (if caot1 (setq h caot1))
  (command "undo" "be")
  (setq  k 0
tdt 0)
  (setq ss (ssadd))
 
(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq  P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command  "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P6 (* 1.2 h) 0 "BAÛNG THOÁNG KEÂ DIEÄN TÍCH"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "DT (m2)"
);command
(setq PA  (getstring "\n CHON DIEM (1) HAY CHON DOI TUONG (2) < 1 or 2 > : "))
(if (= pa "1")
    (setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
    (setq ep (car (setq e (entsel "\n Chon doi tuong la polyline kin")))
              pt2 (cadr e)  )
)
  (while (or (/= pt1 nil) (/= ep nil) )
(setq k (+ 1 k))
                  (if pt1
(command "TEXT" "m" pt1 (* 1 h) 0 (rtos k 2 0))
                  )
                  (if ep
                  (command "TEXT" "m" pt2 (* 1 h) 0 (rtos k 2 0))
                  )
(setq  PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
                  (if  pt1
                      (progn
        (command "CECOLOR" 4 "-boundary" pt1 "" )
        (setvar "CECOLOR" lacol)
        (setq et (entlast))
        (ssadd et ss)
        (command "area" "e" "last")
                      )
                  )
                  (if ep
                      (command "area" "o" ep)
                  )
;;;;;;(setq et (entlast))
;;;;;;(ssadd et ss)
(setq dtcon (* (getvar "AREA") tl tl))
(setq tdt (+ dtcon tdt))
(command "erase" ss "")
 
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P7 h 0 (rtos k 2 0)
"text" "m" P8 h 0 (rtos dtcon 2 2))
                  (if pt1
     (setq pt1 (getpoint "\n chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
                  )
                  (if ep
                      (setq ep (car (setq e (entsel "\n Chon polyline tiep theo hoac enter de ket thuc lenh ..."))) pt2 (cadr e)  )
                  )
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command  "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 ""
"text" "m" P12 h 0 "TOÅNG"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(command "undo" "e")
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
(princ)
)
 

 

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

 Nhờ các bác chỉnh dùm lisp ghi diện tích này dùm em:

1) Mặc định tỉ lệ bản vẽ là 0.001

2) Mặc định chiều cao chữ là 250

3) Hoặc ghi nhớ lần nhập trc đó

Em phải đo diện tích này nhiều mà mỗi lần phải đánh số 0.001 và 250 tốn thao tác + thời gian quá, Xin cám ơn trc ^.^

Bạn sửa 2 dong này lại là được:

 (if (not tl) (setq tl 1)) thay bằng  (if (not tl) (setq tl 0.001))

  (if (not h) (setq h 1)) thay  bằng   (if (not h) (setq h 250)) 

Nếu bạn muốn mặc định không có dòng nhập tỷ lệ và chiều cao nữa ( Cái này nếu đó với tỷ lệ khác sẽ sai và ko nhập được tỷ lệ) thì bạn xóa 4 dòng này đi

(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))

caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))

  (if tl1 (setq tl tl1))

  (if caot1 (setq h caot1))

Chúc bạn sớm làm được 

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  

×