Chuyển đến nội dung
Diễn đàn CADViet
matran

[Đã xong] Nhờ giúp Lisp tính diện tích và lập bảng

Bởi matran , trong AutoLisp

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

SoftvnBin    4

SoftvnBin
Đã đăng

Hề hề hề,

1. Bạn có muốn tự tay mình chỉnh sửa cái lisp cũ thành cái bạn cần hay không???

2. Nều bạn muốn mình sẽ giúp bạn làm thử coi sao.

3. Bạn hãy gửi bản vẽ có cái bảng thống kê tổng hợp của bạn lên để mình có thể check.

4. Tại sao cột ghi chú và cột tên vùng lại có nội dung giống nhau??? Vậy có phải là thừa không???

5. Nội dung text bắt buộc phải là tiếng việt có dấu ư?? Cái này mình chưa rành vì lisp không hiểu tiếng Việt.

Cảm ơn Bình đã quan tâm, mình xin trả lời bạn như sau:

1. Mình rất muốn nhưng dạo này đang bận quả hoàn công, quyết toán (xong chắc phải 1,5 tháng nữa) mà giữa năm thì thanh tra chịu khó đi lắm :(, hẹn bạn xong vụ công trình riêng này đã nhé (kiếm bát gạo xấu nuôi bồ đã)

2. Oke, mình se gửi (bản vẽ không chính xác lắm = thuyết minh :) )

3. Hai cột này có nội dung giống nhau vì mình rất chi là lười :) nếu cần ghi chú thì ed là Oke không phải nối bảng và căn chỉnh text, nếu không thì để trống, nếu không cần và bản vẽ chật quá thì E và TR, F là xong (phá bao giờ cũng nhanh hơn làm mà :) )

4. Nội dung text lấy Text Style hiện hành, bảng mình sẽ lập auto bằng TABLE (TB) mặc định của Autocad thì việc tiếng việt có dấu mình nghĩ sẽ làm được phải không bạn ?

http://www.cadviet.com/upfiles/3/17200_cadviet_s_c_w.dwg

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

SoftvnBin    4

SoftvnBin
Đã đăng

Bác Bình cũng đi kiếm tí rồi bạn ạ :">

Đêm hôm mà phải đi cũng kiếm được à, há há (sao ý nghĩ mình đen tối thế), mình lại phải ở nhà kiếm tý, buồn thật!!

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Đêm hôm mà phải đi cũng kiếm được à, há há (sao ý nghĩ mình đen tối thế), mình lại phải ở nhà kiếm tý, buồn thật!!

Hề hề hề,

Đêm có tí đêm , ngày có tí ngày chớ bộ.

Đây là cái tí đêm hôm qua cho bạn nè:


(defun c:aaa (/ lacol ladin laos tl esty h tl1 cao1 k tdt ss pt p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13
                       p14 p15 p16 p17 p18 p19 p20 pa pt1 pt2 e ep  et dtcon cvcon klcon klt klr kl0 cvt ten oldla)
 (setvar "cmdecho" 0)
 (setq lacol (getvar "CEColor"))
 (setq ladin (getvar "dimzin"))
 (setq laos (getvar "osmode"))
 (setq oldla (getvar "clayer"))
 (setq esty (tblsearch "style" (getvar "textstyle")))
 (if (not tl) (setq tl 1))
 (if (= (cdr (assoc 40 esty)) 0.0)
     (if (= (cdr (assoc 42 esty)) 0.0) (setq h 1) (setq h (cdr (assoc 42 esty)))  )
  	(progn
      	(setq h (cdr (assoc 40 esty)))
      	(command "style" (getvar "textstyle") "" 0.0 "" "" "" "")          
  	)
 )
 (if (not kl0) (setq kl0 2500))
 (setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
           caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: "))
           klr (getreal (strcat "\n Khoi luong rieng < " (rtos kl0 2 2) " >: ")))
 (if tl1 (setq tl tl1))
 (if caot1 (setq h caot1))
 (if klr (setq kl0 klr) (setq klr kl0) )
 (command "undo" "be")
 (setq  k 0 tdt 0 cvt 0 klt 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)(* 45 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)))
P9 (list (+ (car P2) (* 16 h)) (cadr P2))
P10 (list (+ (car P9) (* 16 h)) (cadr P9))
P11 (list (+ (car P10) (* 20 h)) (cadr P10))
P12 (list (+ (car P11) (* 16 h)) (cadr P11))
P13 (list  (car P9) (cadr P5))
P14 (list (car P10) (cadr P5))
P15 (list (car P11) (cadr P5))
P16 (list (car P12) (cadr P5))
P17 (list (+ (car P8) (* 16 h)) (cadr P8))
P18 (list (+ (car P17) (* 16 h)) (cadr P8))
P19 (list (+ (car P18) (* 18 h)) (cadr P8))
P20 (list (+ (car P19) (* 18 h)) (cadr P8))
);setq
(setvar "clayer" "khung duong")
(command  "pline" PT P12 P16 P3 "C"
"pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "")
(setvar "clayer" "text")
(command "text" "m" P6 (* 1.35 h) 0 "BANG THONG KE TONG HOP"
"text" "m" P7 (* 1.2 H) 0 "STT"
"text" "m" P8 (* 1.2 h) 0 "TEN VUNG"
"TEXT" "M" P17 (* 1.2 h) 0 "CHU VI (M)"
"TEXT" "M" P18 (* 1.2 h) 0 "DIEN TICH (M2)"
"TEXT" "M" P19 (* 1.2 h) 0 "KHOI LUONG (KG)"
"TEXT" "M" P20 (* 1.2 h) 0 "GHI CHU"
);command
(setq PA  (getstring "\n Ban chon phuong an chon doi tuong < 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.2 h) 0 (rtos k 2 0))
    	)
    	(if ep
             (command "TEXT" "m" pt2 (* 1.2 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))
;;;;P6 (list (+ (car PT)(* 43 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)))
P9 (list (+ (car P2) (* 16 h)) (cadr P2))
P10 (list (+ (car P9) (* 16 h)) (cadr P9))
P11 (list (+ (car P10) (* 20 h)) (cadr P10))
P12 (list (+ (car P11) (* 16 h)) (cadr P11))
P13 (list  (car P9) (cadr P5))
P14 (list (car P10) (cadr P5))
P15 (list (car P11) (cadr P5))
P16 (list (car P12) (cadr P5))
P17 (list (+ (car P8) (* 16 h)) (cadr P8))
P18 (list (+ (car P17) (* 16 h)) (cadr P8))
P19 (list (+ (car P18) (* 18 h)) (cadr P8))
P20 (list (+ (car P19) (* 18 h)) (cadr P8))
);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))
(setq cvcon (* (getvar "Perimeter") tl)
         cvt (+ cvt cvcon)
         klcon (* dtcon klr)
         klt (+ klt klcon)
         ten (strcat "\n VUNG " (rtos k 2 0))
)
(command "erase" ss "")
(setvar "clayer" "khung duong")
(command  "pline" PT P3 P16 P12 ""
"pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "")
(setvar "clayer" "text")
(command "text" "m" P7 h 0 (rtos k 2 0)
"text" "m" P8 h 0 ten
"TEXT" "M" P17 (* 1.0 h) 0 (rtos cvcon 2 2)
"TEXT" "M" P18 (* 1.0 h) 0 (rtos dtcon 2 2)
"TEXT" "M" P19 (* 1.0 h) 0 (rtos klcon 2 2)
"TEXT" "M" P20 (* 1.0 h) 0 ten )
                 (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)
(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))
;;;P6 (list (+ (car PT)(* 43 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)))
P9 (list (+ (car P2) (* 16 h)) (cadr P2))
P10 (list (+ (car P9) (* 16 h)) (cadr P9))
P11 (list (+ (car P10) (* 20 h)) (cadr P10))
P12 (list (+ (car P11) (* 16 h)) (cadr P11))
P13 (list  (car P9) (cadr P5))
P14 (list (car P10) (cadr P5))
P15 (list (car P11) (cadr P5))
P16 (list (car P12) (cadr P5))
P17 (list (+ (car P8) (* 16 h)) (cadr P8))
P18 (list (+ (car P17) (* 16 h)) (cadr P8))
P19 (list (+ (car P18) (* 18 h)) (cadr P8))
P20 (list (+ (car P19) (* 18 h)) (cadr P8))
);setq
(setvar "clayer" "khung duong")
(command  "pline" PT P3 P16 P12 ""
"pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "")
(setvar "clayer" "text")
(command "text" "m" P7 (* 1.1 h) 0 "TONG"
"text" "m" P8 (* 1.1 h) 0 (strcat (rtos k 2 0) " VUNG")
"TEXT" "M" P17 (* 1.1 h) 0 (rtos cvt 2 2)
"TEXT" "M" P18 (* 1.1 h) 0 (rtos tdt 2 2)
"TEXT" "M" P19 (* 1.1 h) 0 (rtos klt 2 2)
"TEXT" "M" P20 (* 1.1 h) 0 (strcat (rtos k 2 0) " VUNG") )
(command "undo" "e")
(setvar "OSMODE" laos)
(setvar "clayer" oldla)
(setvar "cmdecho" 1)
(princ)
)

Hy vọng đúng ý bạn.

Riêng cái vụ khối lượng thì không thể có đơn vị là kg/m được nên mình đã tự sửa thành kg. Nếu bạn không thích thì tự sửa lại nhé.

  • Vote tăng 2

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

quickandfine    10

quickandfine
Đã đăng

Cảm ơn Anh Tuệ rất nhiều. :bigsmile:

Đây là lisp đã đã được sửa để tính diện tích cả hình có lỗ khoét và không có lỗ khoét.

(defun c:bdt()(setvar "cmdecho" 0)(command "undo" "begin")(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 2) " >: ")))(if tl1 (setq tl tl1))(if caot1 (setq h caot1))(setq k 0 tdt 0)(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 "%¶ng thèng kª diÖn tÝch"        "text" "m" P7 h 0 "STT"        "text" "m" P8 h 0 "DiÖn tÝch (m2)");command(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))(while (/= pt1 nil)(command "erase" ss "")(setq k (+ 1 k))(command "TEXT" "m" pt1 (* 3 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(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary(command "cecolor"4 "-boundary" pt1 "");; boundary(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary(setq cur frome	ss (ssadd) S 0)(while 	(not (eq cur toe));; chon cac doi tuong tu frome den toe	(setq cur (entnext cur) ss (ssadd cur ss))	(command "area" "S" "O" ss "" "")	(setq dt (getvar "area") S (+ S dt)));while(command "area" "A" "O" "L" "" "")(setq dt (getvar "area"))(setq S (* (+ S (* dt 2)) tl tl) tdt (+ s tdt))  (setvar "CEColor" lacol)(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 s 2 2))(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo..."))));while(command "erase" ss "")(setq ss nil)(setvar "DIMZIN" ladin)(command 	"pline" P3 P9 P11 P5 "C"        "pline" P10 P4 ""        "text" "m" P12 h 0 "Tæng"        "text" "m" P13 h 0 (rtos tdt 2 2));command(setvar "OSMODE" laos)(command "undo" "end")(setvar "cmdecho" 1))

 

@vantiteo: Mình đang bận quá, tranh thủ thời gian ngủ trưa để sửa lại lisp này cho mọi người thôi. bạn có thể xem lisp của anh Tuệ để tìm ra chỗ thiếu sót của bạn. lisp của anh Tuệ rất hay.

@xuandao0708: Bạn cần phân biệt tỷ lệ vẽ và tỷ lệ in nhé. lisp này yêu cầu nhập vào tỷ lệ vẽ vì chỉ có tỷ lệ vẽ mới ảnh hưởng trực tiếp đến kết quả tính toán. theo như bạn nói thì thì tỷ lệ 1/500 của bạn chính là tỷ lệ in của bản vẽ ra giấy. còn thực chất bản vẽ của bạn vẫn được vẽ với tỷ lệ 1/1. nghĩa là 1 đơn vị vẽ trong cad sẽ tương ứng với 1 đơn vị đo ngoài thực địa.

Chào bác Thaistreetz. Bác cho em hỏi chút ạ.

-Nếu em muốn phần tỷ lệ trong đoạn lisp này luôn là 1:1 thì em phải sửa thế nào ạ?

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Chào bác Thaistreetz. Bác cho em hỏi chút ạ.

-Nếu em muốn phần tỷ lệ trong đoạn lisp này luôn là 1:1 thì em phải sửa thế nào ạ?

Hề hề hề,

Bác Thái đang bận, mình trả lời thay được không hè???

Bỏ tất cả những gì liên quan tới biến tl1 đi.

  • Vote tăng 2

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

quickandfine    10

quickandfine
Đã đăng

Hề hề hề,

Bác Thái đang bận, mình trả lời thay được không hè???

Bỏ tất cả những gì liên quan tới biến tl1 đi.

Hehe

Cảm ơn anh phamthanhbinh 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

SoftvnBin    4

SoftvnBin
Đã đăng

Hề hề hề,

Đêm có tí đêm , ngày có tí ngày chớ bộ.

Đây là cái tí đêm hôm qua cho bạn nè:

..........................................

Hy vọng đúng ý bạn.

Riêng cái vụ khối lượng thì không thể có đơn vị là kg/m được nên mình đã tự sửa thành kg. Nếu bạn không thích thì tự sửa lại nhé.

Không biết nói lời cảm ơn bạn thế nào, từ đáy lòng mình chúc bạn cùng toàn thể gia đình lời cảm ơn chân thành nhất, đưa điện thoại lên đây thì không tiện, yahoo thì muộn mất, có cách nào để biết khi nào bạn có dịp ghé qua Vĩnh Phúc không 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

huaductiep    2

huaductiep
Đã đăng

Lisp rất tuyệt vời..Cám ơn các bác rất nhiều. Nhưng mình mong các bác có thể sửa lisp sao cho có thể chon được nhiều miền diện tích 1 lúc được ko ah?? Vì đôi khi miền tính diện tích của mình gồm rất nhiều miền nhỏ. (vẫn có thể trừ đi các phân` bị khoét lỗ bên trong)

  •  Lệnh: bdt
  • Nhập tỷ lệ bản vẽ (như cũ)
  • Nhập chiều cao Text (như cũ)
  • Chọn điểm xuất bang thống kê diện tích (như cũ)
  • Click điểm thuộc miền cần tính diện tích
  • Click điểm tiếp theo
  • Ấn phím CÁCH (BACKSPACE) để hoàn thành tổng diện tích các miền vừa click
  • Click điểm thuộc miền cần tính diện tích
  • Click điểm tiếp theo
  • Ấn phím CÁCH (BACKSPACE) để hoàn thành tổng diện tích các miền vừa click...
  • Ấn phím Enter để kết thúc lệnh.

Mong các bác sẽ giúp. Cám ơn mọi người đã đọc bà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

legiang610    2

legiang610
Đã đăng

 

Hề hề hề,

Mình giúp bạn lần này đưa vấn đề bạn hỏi về cùng topic gốc. Lần sau bạn nên rút kinh nghiệm để diễ đàn đỡ rối rắm.

Bạn dùng thử cái này xem đã ưng ý chưa nhé.

 
(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 "Bang thong ke dien tich"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "Dien tich (mm2)"
);command
(setq PA  (getstring "\n Ban chon phuong an chon doi tuong < 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 hoạc 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 "Tong"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(command "undo" "e")
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
(princ)
)
Chúc bạn vui......

lisp này của bác thuận tiện quá, nhưng do đặc thù công việc của e hay dùng tỷ lệ 1/1000 ( tính diện tích ra m2) và chiều cao text 200, vậy hỏi bác muốn thiết lâp tỷ lệ và chiều cao text như trên làm giá trị mặc định thì sửa ở đâu ạ. cảm ơn bá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

bactinhlang8x    1

bactinhlang8x
Đã đăng

Lisp rất tuyệt vời..Cám ơn các bác rất nhiều. Nhưng mình mong các bác có thể sửa lisp sao cho có thể chon được nhiều miền diện tích 1 lúc được ko ah?? Vì đôi khi miền tính diện tích của mình gồm rất nhiều miền nhỏ. (vẫn có thể trừ đi các phân` bị khoét lỗ bên trong)

  •  Lệnh: bdt
  • Nhập tỷ lệ bản vẽ (như cũ)
  • Nhập chiều cao Text (như cũ)
  • Chọn điểm xuất bang thống kê diện tích (như cũ)
  • Click điểm thuộc miền cần tính diện tích
  • Click điểm tiếp theo
  • Ấn phím CÁCH (BACKSPACE) để hoàn thành tổng diện tích các miền vừa click
  • Click điểm thuộc miền cần tính diện tích
  • Click điểm tiếp theo
  • Ấn phím CÁCH (BACKSPACE) để hoàn thành tổng diện tích các miền vừa click...
  • Ấn phím Enter để kết thúc lệnh.

Mong các bác sẽ giúp. Cám ơn mọi người đã đọc bài :)

Em cũng đang rất cần chức năng như thế này. Mong các bác cao thủ giúp cho chót thì LISP này quả là tuyệt vời!

Và em cũng muốn các bác bổ sung thêm chức năng "có đánh số trong miền diện tích không: C/K?"

Cảm ơn các bác đã viết ra những LISP rất hay để a,e có thể áp dụng trong công việc hàng ngày.

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

nguyenbd1    13

nguyenbd1
Đã đăng

 nhờ các bác ảnh giúp e vấn đề này với. giờ em muốn tính thể tích 1 hình hộp chữ nhật. gồm kích thước chiều rộng là a chiều dài là b chiều cao là c... sau khi chọn mỗi cạnh thì chương chính sẽ tự cộng thêm  2mm vào mỗi kích thước và làm phép tính nhân như trong hình gì ra màn hình cad 2 hàng chữ như trong hình rất mong sự giúp đỡ của các anh chị122369_untitled.jpg

  • 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

namgiangduy89    19

namgiangduy89
Đã đăng

Hề hề hề,

Đêm có tí đêm , ngày có tí ngày chớ bộ.

Đây là cái tí đêm hôm qua cho bạn nè:

 
(defun c:aaa (/ lacol ladin laos tl esty h tl1 cao1 k tdt ss pt p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13
                        p14 p15 p16 p17 p18 p19 p20 pa pt1 pt2 e ep  et dtcon cvcon klcon klt klr kl0 cvt ten oldla)
  (setvar "cmdecho" 0)
  (setq lacol (getvar "CEColor"))
  (setq ladin (getvar "dimzin"))
  (setq laos (getvar "osmode"))
  (setq oldla (getvar "clayer"))
  (setq esty (tblsearch "style" (getvar "textstyle")))
  (if (not tl) (setq tl 1))
  (if (= (cdr (assoc 40 esty)) 0.0)
      (if (= (cdr (assoc 42 esty)) 0.0) (setq h 1) (setq h (cdr (assoc 42 esty)))  )
   	(progn
       	(setq h (cdr (assoc 40 esty)))
       	(command "style" (getvar "textstyle") "" 0.0 "" "" "" "")          
   	)
  )
  (if (not kl0) (setq kl0 2500))
  (setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
            caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: "))
            klr (getreal (strcat "\n Khoi luong rieng < " (rtos kl0 2 2) " >: ")))
  (if tl1 (setq tl tl1))
  (if caot1 (setq h caot1))
  (if klr (setq kl0 klr) (setq klr kl0) )
  (command "undo" "be")
  (setq  k 0 tdt 0 cvt 0 klt 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)(* 45 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)))
P9 (list (+ (car P2) (* 16 h)) (cadr P2))
P10 (list (+ (car P9) (* 16 h)) (cadr P9))
P11 (list (+ (car P10) (* 20 h)) (cadr P10))
P12 (list (+ (car P11) (* 16 h)) (cadr P11))
P13 (list  (car P9) (cadr P5))
P14 (list (car P10) (cadr P5))
P15 (list (car P11) (cadr P5))
P16 (list (car P12) (cadr P5))
P17 (list (+ (car P8) (* 16 h)) (cadr P8))
P18 (list (+ (car P17) (* 16 h)) (cadr P8))
P19 (list (+ (car P18) (* 18 h)) (cadr P8))
P20 (list (+ (car P19) (* 18 h)) (cadr P8))
);setq
(setvar "clayer" "khung duong")
(command  "pline" PT P12 P16 P3 "C"
"pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "")
(setvar "clayer" "text")
(command "text" "m" P6 (* 1.35 h) 0 "BANG THONG KE TONG HOP"
"text" "m" P7 (* 1.2 H) 0 "STT"
"text" "m" P8 (* 1.2 h) 0 "TEN VUNG"
"TEXT" "M" P17 (* 1.2 h) 0 "CHU VI (M)"
"TEXT" "M" P18 (* 1.2 h) 0 "DIEN TICH (M2)"
"TEXT" "M" P19 (* 1.2 h) 0 "KHOI LUONG (KG)"
"TEXT" "M" P20 (* 1.2 h) 0 "GHI CHU"
);command
(setq PA  (getstring "\n Ban chon phuong an chon doi tuong < 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.2 h) 0 (rtos k 2 0))
     	)
     	(if ep
              (command "TEXT" "m" pt2 (* 1.2 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))
;;;;P6 (list (+ (car PT)(* 43 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)))
P9 (list (+ (car P2) (* 16 h)) (cadr P2))
P10 (list (+ (car P9) (* 16 h)) (cadr P9))
P11 (list (+ (car P10) (* 20 h)) (cadr P10))
P12 (list (+ (car P11) (* 16 h)) (cadr P11))
P13 (list  (car P9) (cadr P5))
P14 (list (car P10) (cadr P5))
P15 (list (car P11) (cadr P5))
P16 (list (car P12) (cadr P5))
P17 (list (+ (car P8) (* 16 h)) (cadr P8))
P18 (list (+ (car P17) (* 16 h)) (cadr P8))
P19 (list (+ (car P18) (* 18 h)) (cadr P8))
P20 (list (+ (car P19) (* 18 h)) (cadr P8))
);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))
(setq cvcon (* (getvar "Perimeter") tl)
          cvt (+ cvt cvcon)
          klcon (* dtcon klr)
          klt (+ klt klcon)
          ten (strcat "\n VUNG " (rtos k 2 0))
)
(command "erase" ss "")
(setvar "clayer" "khung duong")
(command  "pline" PT P3 P16 P12 ""
"pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "")
(setvar "clayer" "text")
(command "text" "m" P7 h 0 (rtos k 2 0)
"text" "m" P8 h 0 ten
"TEXT" "M" P17 (* 1.0 h) 0 (rtos cvcon 2 2)
"TEXT" "M" P18 (* 1.0 h) 0 (rtos dtcon 2 2)
"TEXT" "M" P19 (* 1.0 h) 0 (rtos klcon 2 2)
"TEXT" "M" P20 (* 1.0 h) 0 ten )
                  (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)
(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))
;;;P6 (list (+ (car PT)(* 43 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)))
P9 (list (+ (car P2) (* 16 h)) (cadr P2))
P10 (list (+ (car P9) (* 16 h)) (cadr P9))
P11 (list (+ (car P10) (* 20 h)) (cadr P10))
P12 (list (+ (car P11) (* 16 h)) (cadr P11))
P13 (list  (car P9) (cadr P5))
P14 (list (car P10) (cadr P5))
P15 (list (car P11) (cadr P5))
P16 (list (car P12) (cadr P5))
P17 (list (+ (car P8) (* 16 h)) (cadr P8))
P18 (list (+ (car P17) (* 16 h)) (cadr P8))
P19 (list (+ (car P18) (* 18 h)) (cadr P8))
P20 (list (+ (car P19) (* 18 h)) (cadr P8))
);setq
(setvar "clayer" "khung duong")
(command  "pline" PT P3 P16 P12 ""
"pline" P1 P4 "" "pline" P2 P5 "" "pline" p9 p13 "" "pline" p10 p14 "" "pline" p11 p15 "" "pline" p12 p16 "")
(setvar "clayer" "text")
(command "text" "m" P7 (* 1.1 h) 0 "TONG"
"text" "m" P8 (* 1.1 h) 0 (strcat (rtos k 2 0) " VUNG")
"TEXT" "M" P17 (* 1.1 h) 0 (rtos cvt 2 2)
"TEXT" "M" P18 (* 1.1 h) 0 (rtos tdt 2 2)
"TEXT" "M" P19 (* 1.1 h) 0 (rtos klt 2 2)
"TEXT" "M" P20 (* 1.1 h) 0 (strcat (rtos k 2 0) " VUNG") )
(command "undo" "e")
(setvar "OSMODE" laos)
(setvar "clayer" oldla)
(setvar "cmdecho" 1)
(princ)
)
Hy vọng đúng ý bạn.

Riêng cái vụ khối lượng thì không thể có đơn vị là kg/m được nên mình đã tự sửa thành kg. Nếu bạn không thích thì tự sửa lại nhé.

 

Để kiểm soát được vùng lấy diện tích ngoài điền số mong Tác giả bổ sung thêm phần tô màu vùng chọn để không xảy ra những sai lầm khi tính diện tích. Xin chân thành cảm ơn.

  • 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

nguyenbd1    13

nguyenbd1
Đã đăng

cảm ơn bạn đã cố gắng nhiệt tình và nhất là anh thanh bình.. nhưng cái lisp này nó không có hoạt động vì khả năng mình có hạn. monng bạn kiểm tra lại dùm tớ vớ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

nguyenbd1    13

nguyenbd1
Đã đăng

cảm ơn bạn nhiều.. có 1 điều là tính khối lượng thì cần cả chiều cao.. nhunh hình như trông lisp  này có chiều cao là mặc định. có cáh nào này chiều cao từ 1 đoạn thẳng trên màn hình không.. tớ mù không biết gì về lisp. monh anh em thông cảm

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

tho33392    0

tho33392
Đã đăng

r.lsp nho cac bac chi giao cho em tại đến hôm nay em mới biết đến lisp nay ...các bác cho em hoi làm sao để sửa lisp này chó xuất ra diện tích là 4 chử số thâp phân phía sau không ạ!!!  em cám ơn rất nhiều ạ ...

 

Untitled-3.jpg

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

nachan    0

nachan
Đã đăng

Lisp quá hay mà đến giờ em mới biết. Các bác giúp em với. Em muốn kèm text vào chung với stt thì mình sửa dòng nào ạ. Em xin cảm ơn ạ

r.lsp

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

vcdichoi    7

vcdichoi
Đã đăng
Vào lúc 30/6/2012 tại 14:08, phamthanhbinh đã nói:

Hề hề hề,

Mình giúp bạn lần này đưa vấn đề bạn hỏi về cùng topic gốc. Lần sau bạn nên rút kinh nghiệm để diễ đàn đỡ rối rắm.

Bạn dùng thử cái này xem đã ưng ý chưa nhé.

  


(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 "Bang thong ke dien tich"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "Dien tich (mm2)"
);command
(setq PA  (getstring "\n Ban chon phuong an chon doi tuong < 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 hoạc 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 "Tong"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(command "undo" "e")
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
(princ)
)
 

 

Chúc bạn vui......

Em chào anh, code rất hay, anh cho em hỏi để đối diện tích từ mm2 ra m2 thì chỉnh lại phần nào trong code ạ!

Em cám ơn anh!

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

vcdichoi    7

vcdichoi
Đã đăng
Vào lúc 23/8/2009 tại 13:26, Thaistreetz đã nói:

Cảm ơn Anh Tuệ rất nhiều. :bigsmile:

Đây là lisp đã đã được sửa để tính diện tích cả hình có lỗ khoét và không có lỗ khoét.

  


(defun c:bdt()
(setvar "cmdecho" 0)
(command "undo" "begin")
(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 2) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))
(setq k 0 tdt 0)

(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 "%%UB¶ng thèng kª diÖn tÝch"
       "text" "m" P7 h 0 "STT"
       "text" "m" P8 h 0 "DiÖn tÝch (m2)"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(command "erase" ss "")
(setq k (+ 1 k))
(command "TEXT" "m" pt1 (* 3 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
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command "cecolor"4 "-boundary" pt1 "");; boundary
(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary
(setq cur frome	ss (ssadd) S 0)
(while 	(not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq cur (entnext cur) ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area") S (+ S dt))
);while
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq S (* (+ S (* dt 2)) tl tl) tdt (+ s tdt))  
(setvar "CEColor" lacol)
(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 s 2 2))
(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo...")))
);while
(command "erase" ss "")
(setq ss nil)
(setvar "DIMZIN" ladin)
(command     "pline" P3 P9 P11 P5 "C"
       "pline" P10 P4 ""
       "text" "m" P12 h 0 "Tæng"
       "text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(command "undo" "end")
(setvar "cmdecho" 1)
)
 

 

 

@vantiteo: Mình đang bận quá, tranh thủ thời gian ngủ trưa để sửa lại lisp này cho mọi người thôi. bạn có thể xem lisp của anh Tuệ để tìm ra chỗ thiếu sót của bạn. lisp của anh Tuệ rất hay.

@xuandao0708: Bạn cần phân biệt tỷ lệ vẽ và tỷ lệ in nhé. lisp này yêu cầu nhập vào tỷ lệ vẽ vì chỉ có tỷ lệ vẽ mới ảnh hưởng trực tiếp đến kết quả tính toán. theo như bạn nói thì thì tỷ lệ 1/500 của bạn chính là tỷ lệ in của bản vẽ ra giấy. còn thực chất bản vẽ của bạn vẫn được vẽ với tỷ lệ 1/1. nghĩa là 1 đơn vị vẽ trong cad sẽ tương ứng với 1 đơn vị đo ngoài thực địa.

Anh ơi cho em hỏi em bị lỗi font khi chạy lisp và vào đâu chỉnh để ra đơn vị diện tích là mét vuông (m2) vậy anh?

Em cám ơn anh!

 

11111.png

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

huunhantvxdts    195

huunhantvxdts
Đã đăng
39 phút trước, vcdichoi đã nói:

Anh ơi cho em hỏi em bị lỗi font khi chạy lisp và vào đâu chỉnh để ra đơn vị diện tích là mét vuông (m2) vậy anh?

Em cám ơn anh!

 

11111.png

Có nhập tỷ lệ đó bạn, bản vẽ đơn vị m thì nhập 1 đơn vị mm thì nhập 0.001 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

vcdichoi    7

vcdichoi
Đã đăng
46 phút trước, huunhantvxdts đã nói:

Có nhập tỷ lệ đó bạn, bản vẽ đơn vị m thì nhập 1 đơn vị mm thì nhập 0.001 nhé

Dạ! vậy còn lỗi font do đâu vậy anh ơ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

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
Về Đầu Trang AutoLisp
×