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

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

Anh thử tìm trong đây xem, nếu thấy anh hãy chia sẻ:

 

http://www.cadviet.com/sub/hsearch.php?cx=...;sa=Search#1345

Cám ơn bạn, những lisp tính diện tích có nhiều trên diễn đàn mình đã tham khảo rồi. Nhưng lisp tính diện tích và lập bảng ngay trên cad thì có lẽ chưa có. Bởi vậy mới nhờ các pác pro giúp đỡ.

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 viết giúp lisp tính diện tích và lập ra bảng như trong hình. Cám ơn các bác rất nhiều

dt.jpg

 

Của bạn đây. lisp sẽ tính diện tích thực theo tỷ lệ bản vẽ bạn nhập vào. đầu tiên bạn phải chọn vị trí đặt bảng thống kê diện tích trên bản vẽ rồi mới pick chọn các miền cần đo diện tích. pick tới đâu diện tích sẽ được thống kê vào bảng đến đó. Mình viết thêm cho bạn một ô tính tổng diện tích các miền đã đo (yêu cầu của bạn không thấy nêu vấn đề này), tuy nhiên bạn phải Enter để kết thúc lệnh (không nhấn Esc nhé) thì lisp mới vẽ được ô cuối cùng này.

(defun c:r()
 (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))

 (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 "%%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)
(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
(command "CECOLOR" 4 "-boundary" pt1 "" )
(setvar "CECOLOR" lacol)
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")				
(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))

(setq pt1 (getpoint "\n chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(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)
(setvar "cmdecho" 1)
)

  • Like 1
  • Vote tăng 9

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
Của bạn đây. lisp sẽ tính diện tích thực theo tỷ lệ bản vẽ bạn nhập vào. đầu tiên bạn phải chọn vị trí đặt bảng thống kê diện tích trên bản vẽ rồi mới pick chọn các miền cần đo diện tích. pick tới đâu diện tích sẽ được thống kê vào bảng đến đó. Mình viết thêm cho bạn một ô tính tổng diện tích các miền đã đo (yêu cầu của bạn không thấy nêu vấn đề này), tuy nhiên bạn phải Enter để kết thúc lệnh (không nhấn Esc nhé) thì lisp mới vẽ được ô cuối cùng này.

 

Cám ơn bạn rất nhiều. Cái cách bạn kẻ ô thật linh động. Bạn thật chu đáo khi tính thêm cái tổng. Nếu có thể bạn xóa cái polyline mới tạo khi tính diện tích và chỉ cần lấy một số lẽ thôi. Một lần nữa xin cám ơn bạn

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
Nếu có thể bạn xóa cái polyline mới tạo khi tính diện tích và chỉ cần lấy một số lẽ thôi. Một lần nữa xin cám ơn bạn

 

Tưởng mỗi mình thức đêm chứ. ^^

Mình đã sửa trực tiếp vào code trên theo như yêu cầu của bạn rồi đấy.

  • Vote tăng 6

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ờ 2 bác Thaitreets và matran ma em xin được lisp tính diện tích hay; nhưng em có ý kiến như này nhờ bác Thaistreets sửa dùm hoặc viết dùm hộ em nhé trên lisp đó nhé:

1 Nét của các ô lưới dường như to quá.

2. Phông chữ bị lỗi, và để kiểu chữ đó thì xấu quá.

3. Các số TT hiện trên hình vẽ, bác có thể để vào một layer khác không? Bởi vì khi xoá chúng đi tiện hơn rất là nhiều (đối với những bản vẽ có nhiều vùng để tính).

4. Bác có thể cho thêm cột toạ độ các điểm vào vì trong quy hoạch có các tiện ích đó nó sẽ tiện hơn.

Nhờ bác Thaistreets giúp em 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

Nhờ các Bác chỉnh lại lisp này dùm em 1 cái, em làm bên trắc địa nên khi yêu cầu nhập tì lệ thì em nhập 1/500 ( tương đương tỉ lệ 1/1), 200 ( tương đương 5/2), 1000 ( tương đương 1/2), 2000 ( tương đương 5/20). Cá mơn các Bác nhiều

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 lại lisp này dùm em 1 cái, em làm bên trắc địa nên khi yêu cầu nhập tì lệ thì em nhập 1/500 ( tương đương tỉ lệ 1/1), 200 ( tương đương 5/2), 1000 ( tương đương 1/2), 2000 ( tương đương 5/20). Cá mơn các Bác nhiều

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
Của bạn đây. lisp sẽ tính diện tích thực theo tỷ lệ bản vẽ bạn nhập vào. đầu tiên bạn phải chọn vị trí đặt bảng thống kê diện tích trên bản vẽ rồi mới pick chọn các miền cần đo diện tích. pick tới đâu diện tích sẽ được thống kê vào bảng đến đó. Mình viết thêm cho bạn một ô tính tổng diện tích các miền đã đo (yêu cầu của bạn không thấy nêu vấn đề này), tuy nhiên bạn phải Enter để kết thúc lệnh (không nhấn Esc nhé) thì lisp mới vẽ được ô cuối cùng này.

(defun c:r()
(vl-load-com)
(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))

(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 ""
"style" "chuv" "VNI-Helve-condense" "" "1" "" "" ""
"text" "m" P6 (* 1.2 h) 0 "%%UBAÛNG THOÁNG KEÂ DIEÄN TÍCH"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "DIEÄN TÍCH (M2)"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(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
(command "CECOLOR" 4 "-boundary" pt1 "" )
(setvar "CECOLOR" lacol)
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last") 
(setq et (entlast))
(ssadd et ss)
(setq dtcon (* (getvar "AREA") 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))

(setq pt1 (getpoint "\n chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 ""
"style" "chuv" "VNI-Helve-condense" "" "1" "" "" ""
"text" "m" P12 h 0 "TOÅNG"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
)

Nếu được bạn bổ sung thêm gán text là font Vni-Hel thì đẹp mắt hơn bạn à, chứ như thế xấu quá

Xin lỗi bạn Thaistreetz mình xin bổ sung thêm gán text lá font Vni-helcon để bạn nào có nhu cầu thì sử dụng

Chỉnh sửa theo HoangSon614
  • Vote tăng 3

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

Việc mình không tạo textstyle riêng cho lisp này là có 1 vài lý do.

1. việc lisp tạo ra 1 textstyle mới rất có thể sảy ra trường hợp trùng tên với 1 textstyle đã có trong bản vẽ. và như thế lisp có thể gây ra sự thay đổi về font chữ của các chi tiết khác ngoài ý muốn.

2. việc sử dụng font chữ nào còn tùy vào nhu cầu của người sử dụng. mỗi người thích dùng 1 loại font chữ khác nhau, với mỗi loại bản vẽ cũng lại có những font chữ mang đặc thù riêng.

3. Lisp sẽ sử dụng textstyle hiện thời khi bạn vẽ. như thế sẽ đảm bảo sự đồng bộ về các textstyle của người sử dụng. ngoài ra nó cũng giúp người sử dụng có được sự lựa chọn linh động hơn cho nhu cầu của mình.

Mình là KS người Băc, KS ngoài này thường thích sử dụng bảng mã TCVN3 nên mình mặc định lisp chạy với TCVN3. còn các bạn miền nam thì lại thích sử dụng bảng mã VNI hơn. các bạn cần chỉnh lại 1 chút trước khi sử dụng.

  • Vote tăng 4

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 lại lisp này dùm em 1 cái, em làm bên trắc địa nên khi yêu cầu nhập tì lệ thì em nhập 1/500 ( tương đương tỉ lệ 1/1), 200 ( tương đương 5/2), 1000 ( tương đương 1/2), 2000 ( tương đương 5/20). Cá mơn các Bác nhiều

Mình ko fải dân trắc địa nên không hiểu lắm ý của bạn về mấy tỷ lệ kia.

Theo như mình hiểu thì cái bạn cần không fải là diện tích thực tế mà là diện tích thực tế /500 lần. Nếu đúng vậy thì con số này dùng vào việc gì 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
.............

2. việc sử dụng font chữ nào còn tùy vào nhu cầu của người sử dụng. mỗi người thích dùng 1 loại font chữ khác nhau, với mỗi loại bản vẽ cũng lại có những font chữ mang đặc thù riêng.

3. Lisp sẽ sử dụng textstyle hiện thời khi bạn vẽ. như thế sẽ đảm bảo sự đồng bộ về các textstyle của người sử dụng. ngoài ra nó cũng giúp người sử dụng có được sự lựa chọn linh động hơn cho nhu cầu của mình.

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

Đồng ý với bạn, tương tự lệnh LINE, TEXT ... trong CAD, lệnh trong LISP nên lấy các giá trị hiện hành như : layer, linetype, textstyle, ...

Viêc sử dụng layer, linetype, textstyle, ... nào sẽ do người dùng quyết định.

(Trừ trường hợp LISP được viết theo Đơn đặt hàng cụ thể.)

 

......... font Vni-Hel thì đẹp mắt hơn bạn à, chứ như thế xấu quá
font đẹp hay xấu là theo chủ quan của mỗi người, đặc biệt là ý của chủ đầu tư. (khách hàng là thượng đế)
  • 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

Cá mơn Thaistreetz và Bác giabach nhiều, vì mình là dân trác địa nên tỷ lẽ bạn vẽ của mình là 1/500 tương đưong với tỷ lệ thực của bản vẽ là 1/1, nếu mình vẽ ở tỷ lệ 1/200 tương dương với tỷ lệ thực của bản vẽ là 2/5. Sau đây là file mẫu của mình theo 4 tỷ lệ khác nhau nhưng cùng kích thước hình học.http://www.cadviet.com/upfiles/2/mau_6_1.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

Nhờ thaistreetz có thể làm cho lisp tính diện tích này có thể tính diện tích có trừ đi phần diện tích lỗ khoé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
Nhờ thaistreetz có thể làm cho lisp tính diện tích này có thể tính diện tích có trừ đi phần diện tích lỗ khoét

Chào thaistreetz :

Bạn có thể xem code ở bài viết của Tue_NV có tính diện tích trừ đi phần lỗ khoét.

Nếu đa giác không khoét lỗ : tính diện tích của đa giác

Nếu đa giác khoét lỗ : tính diện tích của đa giác trừ đi phần khoét lỗ

http://www.cadviet.com/forum/index.php?sho...amp;#entry53407

Hy vọng bạn xây dựng code này thành công

  • 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

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.

  • Vote tăng 6

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
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/"))
   caot1 (getreal (strcat "\nCao text : ")))
(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) 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.

Rất mừng vì bạn đã xây dựng thành công code này. Và có lẽ người được chúng ta cảm ơn nhiều nhất chính là bác Hoành vì bác Hoành đã góp phần cho chúng ta có được code hay và xây dựng được các chương trình rất hay

Một lần nữa cảm ơn bác Hoành. Thanks

  • 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

Cám ơn thaistreetz và anh tuệ nhé đây la chương trình mình đã thêm phần tính khối lượng, vì mình làm đóng tàu nên khối lượng riêng mình lấy là của thép mọi người tham khảo nhé

http://www.cadviet.com/upfiles/2/ert_1.lsp

  • Like 1
  • 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

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

Bạn Thaistreetz có thể xem lại giúp mình không, cái này khi tính với tỷ lệ 1/1 thì d/t đúng, nhưng với những tỷ lệ khác thì không chính xác

(VD: Mình có khu đất 10.000m2 (100x100) vẽ với tỷ lệ 1/10 thì chiều dài mỗi cạnh là 100, nhưng d/t tính ra là 1000m2, vậy thiếu đi 10 lần)

Mình muốn là nhập tỷ lệ bản vẽ vào thì lisp tự tính diện tích sao cho d/t đó là d/t thực của khu đất. Cảm ơn bạ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

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

×