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

[ptd1987 5]

 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)
)
 

 

[huunhantvxdts 195]

 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 

[ptd1987 5]

em làm thành công rồi ^.^ Thanks bác nhiều lắm lắm !! (mà ko thấy nút thanks ở đâu =.=)