AutoLisp trong AutoCad để tính diện tích

Thành viên đã xem (Total:0)

bibobibo81

Thành viên mới
Tham gia
30/5/08
Bài viết
2
Thích
0
Điểm thành tích
1
Tuổi
36
#1
Chào các anh/chị,

Em thấy đa số hiện nay các file lisp tính diện tích chỉ có chọn điểm ghi diện tích vừa tính ra. Hiện em đang cần file lisp pick điểm tính diện tích và chọn text có sẵn, xóa text cũ và ghi diện tích vừa tính vào đó. [Với lisp này hỗ trợ thiết kế đường - tính toán khối lượng đào đắp nhanh hơn]

Có anh nào có cho em một bản nhé: email bibobibo81@yahoo.com

Đây là Code file lisp của em (font TCVN3, anh/chị thử dùng Unikey đổi sang Unicode nhé)

(defun DXF (code elist)
(cdr (assoc code elist))
);dxf

(defun c:Arr(/ dtl dtcon pt1 pt2 ss et oslast vsize)
(if (= tl nil) (progn
(setq tl (getreal "\n VÏ tØ lÖ nhiªu vËy ®¹i ka?(Dïng trong tÝnh diÖn tÝch ®/víi b/vÏ tØ lÖ 1000 [®.vÞ m]): "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nChän mét ®iÓm bÊt kú trong h×nh hehehe(*__*): "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 5))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nTæng diÖn tÝch c¸c h×nh mµ b¹n ®· chän : " (rtos dtcon 2 2)))
(print)
(print)
(setq pt1 (getpoint "\nChän tiÕp h×nh nµo kh«ng ®¹i ca?(^__^): "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
; (setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nTæng diÖn tÝch c¸c h×nh b¹n ®· chän : " (rtos dtl 2 2)))
(print)
(setq pt2 (getpoint "\n§iÓm ®Æt diÖn tÝch: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "0.4" "0" (rtos dtl 2 2))
);if
(princ)
);defun Arr
;------------------------------------------------------------------------
(defun c:AR2(/ dtl dtcon pt1 pt2 ss et oslast vsize)
(if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
; (setq ntl (/ 1000 tl))
; (setq tl2 (* ntl ntl))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(setq ntl (/ 1000 tl))
(setq tl2 (* ntl ntl))

(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 5))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (/ (getvar "AREA") tl2))
(setq dtl (+ dtcon dtl))
(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
; (setq dtl (/ (/ dtl tl2) 2))
(setq dtl (/ dtl 2))
(print)
(prompt (strcat "\nHaft total area : " (rtos dtl 2 4)))
(print)
(setq pt2 (getpoint "\nPoint to write: "))
(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
(command "text" pt2 "0" (rtos dtl 2 2))
(command "text" pt2 "2" "0" (rtos dtl 2 2))
);if
(princ)
);defun AR2
;-------------------------------------------------------------------------------
(defun C:vd()
(print)
(print)
(print)
(setq last (getvar "OSMODE"))
(command "setvar" "OSMODE" "33")
(command "setvar" "DIMZIN" 0 )

(if (= tl nil) (setq tl (getreal "TØ lÖ b¶n vÏ lµ nhiªu vËy ®¹i ka?(*____*) : ")))

(setq PT1 (getpoint "Chän ®iÕm 1 (®iÓm ®Çu) : "))
; (setq PT2 (getpoint "Chän ®iÓm 2 : "))
; (setq dist1 (distance pt1 pt2))
; (setq ntl (/ 1000 tl))
; (setq dist (/ dist1 ntl))
(setq sum 0)

(while (/= pt1 nil)
(setq PT2 (getpoint "Chän tiÕp ®iÓm n÷a koi (®iÓm cuèi): "))
(print)
(setq dist1 (distance pt1 pt2))
(setq ntl (/ 1000 tl))
(setq dist (/ dist1 ntl))
(prompt (strcat "\n ChiÒu dµi ®o¹n võa ®o lµ " (rtos dist 2 4)))
(print)
(setq sum (+ sum dist))
(setq PT1 (getpoint "Chän ®iÓm 1 nhanh ®i (®iÓm ®Çu ®o¹n kh¸c): "))
);while

(prompt (strcat "\n Tæng chiÒu dµi lµ " (rtos sum 2 4)))
(print)
(command "setvar" "OSMODE" "64")
(setq pt3 (getpoint "Ghi ra chç nµo ®©y ®¹i ka?! : "))
;(setq x (+ (car pt3) 2))
;(setq pt3 (list x (cadr pt3)))
(setq sum2 (+ (/ sum 2) 1))

(command "text" pt3 "0.4" "0" (rtos sum 2 2))

(command "setvar" "OSMODE" last)
(princ)
)


(prompt "\n §¸nh lÖnh: ARR pick chän ®iÓm trong h×nh bÊt kú")
(prompt "\n Start with AR2 to calculate haft area by pick points method")
(prompt "\n §¸nh lÖnh: VD ®Ó tÝnh tæng chiÒu dµi c¸c ®o¹n cÇn ®o ")
(prompt "\n By Huúnh Thanh Trang")
(prompt "\n All right Reserved ™")
(princ)

(princ "\n www.cuibap.com.vn")
(princ "\n Danh ,, the hien Bang Welcome!")

(defun C:,,( / dcl_id )
(setq dcl_id (load_dialog "keke.dcl")) ; Load the DCL file.
(if (not (new_dialog "keke" dcl_id)) ; Initialize the dialog.
(exit) ; Exit if this doesn't
; work.
)
(start_dialog) ; Display the dialog
; box.
(princ)

)
;******************************************************************************
;;;
;;; Cong don cac so chon
;
****************************************************************
(prompt "\n §¸nh lÖnh: CV Céng c¸c text (sè) ")
(prompt "\n B¶n quyÒn cuibap.com.vn (C)")

(defun C:cv (/ cnt enam ent pnt s1 tot v1 val)
(setvar "CMDECHO" 0.000)
(prompt "\nChän c¸c sè muèn céng: ")
(setq s1 (ssget))
(prompt "\n§iÓm ®Æt kÕt qu¶: ")
(setq pnt (getpoint))
(setvar "cmdecho" 0.000)
(setq tot 0.000)
(if s1
(progn
(setq cnt (1- (sslength s1)))
(while (>= cnt 0.000)
(setq enam (ssname s1 cnt))
(setq ent (entget enam))
(if (= (cdr (assoc 0.000 ent)) "TEXT")
(progn
(setq v1 (assoc 1 ent))
(setq val (atof (cdr v1)))
(if (and (numberp val) (/= val 0.000))
(progn
(setq tot (+ val tot))
)
)
)
)
(setq cnt (1- cnt))
))
)
(setq tot (rtos tot 2))
(command "text" pnt "" "" tot)
(princ)
(setvar "cmdecho" 1)
)
Em muốn file lisp pick điểm tính diện tích và chọn text có sẵn, xóa text cũ và ghi diện tích vừa tính vào đó. Anh/chị/em xem và chỉnh sửa giúp nhé, đang cần gấp lắm :(
 

Attachments

KTS_DUY

Thành viên năng động
Tham gia
12/5/08
Bài viết
79
Thích
0
Điểm thành tích
6
Tuổi
40
#2
Mình đã sửa lại bạn xem có đúng ý không. Mình chỉ chỉnh lại cách thức xuất kết quả chứ không can thiệp vào quá trình tính toán của lisp. Bạn nên kiểm tra vài trường hợp nhé. Tên lệnh như cũ.
 

Attachments

bibobibo81

Thành viên mới
Tham gia
30/5/08
Bài viết
2
Thích
0
Điểm thành tích
1
Tuổi
36
#3
Mình đã sửa lại bạn xem có đúng ý không. Mình chỉ chỉnh lại cách thức xuất kết quả chứ không can thiệp vào quá trình tính toán của lisp. Bạn nên kiểm tra vài trường hợp nhé. Tên lệnh như cũ.
Rất cám ơn bạn lisp sử dụng tốt lắm, đúng như mong muốn của mình :D
 

sannangkythuat

Thành viên có triển vọng
Tham gia
2/4/09
Bài viết
7
Thích
0
Điểm thành tích
1
#4
Mình đã sửa lại bạn xem có đúng ý không. Mình chỉ chỉnh lại cách thức xuất kết quả chứ không can thiệp vào quá trình tính toán của lisp. Bạn nên kiểm tra vài trường hợp nhé. Tên lệnh như cũ.
Bạn ơi cho mình hỏi, tên lệnh là gì vậy. Mình cũng đang cần lisp này bạn àh
 

KTS_DUY

Thành viên năng động
Tham gia
12/5/08
Bài viết
79
Thích
0
Điểm thành tích
6
Tuổi
40
#5
Bạn ơi cho mình hỏi, tên lệnh là gì vậy. Mình cũng đang cần lisp này bạn àh
Bạn hỏi bạn bibobibo81 ấy. Có tới mấy lệnh lận mình chỉ thên 1 đoạn code xuat kết quả thôi chứ không rỏ lắm về tác dụng của từng lệnh.
 

sannangkythuat

Thành viên có triển vọng
Tham gia
2/4/09
Bài viết
7
Thích
0
Điểm thành tích
1
#6
Xin trợ giúp

Rất cám ơn bạn lisp sử dụng tốt lắm, đúng như mong muốn của mình :D
Mình cũng tải lisp đó về rồi mà ko biết sử dụng. vi font chữ lỗi ko dọc được. Bạn giúp mình với.
 

sannangkythuat

Thành viên có triển vọng
Tham gia
2/4/09
Bài viết
7
Thích
0
Điểm thành tích
1
#7
Chào anh Duy, Em đang tự học auto cad nên kiến thúc còn rất yếu. Mà ko biết hỏi ai, ko biết anh có thời gian có thể giúp em được ko. Nếu được anh cho em xin Yahoo chat của anh để khi nao có việc gì hóc búa mong anh chỉ giáo!
E Dũng
dungnguyen99@mail.com
Y!m: dungctq
Thanks
 

Chutmayman

Thành viên BQL Diễn đàn
Tham gia
9/10/07
Bài viết
630
Thích
706
Điểm thành tích
93
Website
giaxaydung.vn
#8
Bạn ơi cho mình hỏi, tên lệnh là gì vậy. Mình cũng đang cần lisp này bạn àh
Bạn mở file lisp bất kỳ ra sẽ thấy dòng lệnh defun c:Arr
Tất cả phần phía sau sẽ là lệnh để bạn gọi lisp. Trong lisp này có lệnh Arr, AR2, vd, cv.
 

KTS_DUY

Thành viên năng động
Tham gia
12/5/08
Bài viết
79
Thích
0
Điểm thành tích
6
Tuổi
40
#9
Chào anh Duy, Em đang tự học auto cad nên kiến thúc còn rất yếu. Mà ko biết hỏi ai, ko biết anh có thời gian có thể giúp em được ko. Nếu được anh cho em xin Yahoo chat của anh để khi nao có việc gì hóc búa mong anh chỉ giáo!
E Dũng
dungnguyen99@mail.com
Y!m: dungctq
Thanks
Mình hay online trong giờ hành chính (máy cơ quan :">)
Y!m: mat_biec_15
 

tranhung1987

Thành viên mới
Tham gia
20/4/09
Bài viết
3
Thích
0
Điểm thành tích
1
#10
anh chi nao co lisp chuyen so lieu tu cad sang van ban co duoi la ".txt" ko? neu co thi cho minh xin ti vi minh rat can chuyen so lieu dao dap tu cad sang van ban excel. minh thanks truoc nha!
trandinhhung10051987@yahoo.com.vn
 

daodinhdung

Thành viên sắp lên hạng rất nhiệt tình
Tham gia
21/4/09
Bài viết
248
Thích
111
Điểm thành tích
43
Tuổi
46
#11
anh chi nao co lisp chuyen so lieu tu cad sang van ban co duoi la ".txt" ko? neu co thi cho minh xin ti vi minh rat can chuyen so lieu dao dap tu cad sang van ban excel. minh thanks truoc nha!
trandinhhung10051987@yahoo.com.vn
(chuyen so lieu dao dap tu cad sang van ban excel). nếu như bạn chạy phần mền về giao thông, san nền thì sẽ có menu phụ trợ để xuất các bảng khối lượng từ cad sang excel rất nhanh.
 

Bùi Đức Long

Thành viên rất triển vọng
Tham gia
25/2/09
Bài viết
29
Thích
0
Điểm thành tích
1
Tuổi
39
#12
Bạn ơi cho mình hỏi, tên lệnh là gì vậy. Mình cũng đang cần lisp này bạn àh
Mở lisp cad ra rùi tìm các dòng nào có defun c:... thì đằng sau nó là lệnh
 

thanhpc3idn

Thành viên mới
Tham gia
21/6/10
Bài viết
2
Thích
0
Điểm thành tích
1
#13
Chào bạn Duy

Mình hay online trong giờ hành chính (máy cơ quan :">)
Y!m: mat_biec_15
Mình đã lấy bản Lisp tính diện tích của bạn sửa về xài rồi, nhưng mỗi lần kích xuất kết quả nó toàn cho giá trị là 0 thôi ah, mình cũng xài bản dientich1 nó chỉ cho kết quả trên thanh công cụ chứ không hiển thị trên bản vẽ. Ngày trước xài thì ngon, lâu lâu xài lại không được, trứoc dùng lisp có lệnh đánh là DT1 chạy ngon, nhưng lỗi ở cái phần xuất giá trị toàn là 0 ah.
bạn có bản nào xịn khoong cho moi người với. Mình làm bên khảo sát, thỉnh thoảng tính khối lượng bằng mặt cắt, nên cũng rất cần cái tính diện tích để tính khi cắt mặt cắt và áp với thiết kế, làm thủ công lâu qua. xin cảm ơn nhiều
 

vukhang86

Thành viên nhiều triển vọng
Tham gia
27/12/10
Bài viết
15
Thích
0
Điểm thành tích
1
#14
líp la j vay may anh em moi ra nghe nen hok bt????:(
 

manh_docco

Thành viên mới
Tham gia
1/6/10
Bài viết
1
Thích
0
Điểm thành tích
1
Tuổi
33
#15
lisp tinh dien tich

:)) lisp tinh dien tich rat hay ma minh van hay dung
lenh : DT
 

nguyenthiettien

Thành viên mới
Tham gia
22/11/13
Bài viết
1
Thích
0
Điểm thành tích
1
Tuổi
26
#17
bạn ơi lệnh của nó là gì thế. m cài vào mà ko biết lệnh là gì để dùng :(
 

xuantang88

Thành viên mới
Tham gia
25/2/14
Bài viết
1
Thích
0
Điểm thành tích
1
#18
hiện tại mình đang làm hồ sơ thanh toán...mà mình muốn tính diện tích ở trong cad xong là chuyển qua excel lun như vậy để cho nhanh..vậy có cao thủ nào giúp mình vấn đề này được kô?..thanks all
 

thanhtuanxdkt

Thành viên mới
Tham gia
24/10/11
Bài viết
1
Thích
0
Điểm thành tích
1
Tuổi
32
#19
KTS_DUY nói:
Mình đã sửa lại bạn xem có đúng ý không. Mình chỉ chỉnh lại cách thức xuất kết quả chứ không can thiệp vào quá trình tính toán của lisp. Bạn nên kiểm tra vài trường hợp nhé. Tên lệnh như cũ.

Cho mình hỏi sao mình dùng lệnh SS, sau đó chọn đối tượng và chọn text xuất kq lại bằng 0.000; nhờ các anh chỉ giúp sử dụng Lisp này, cảm ơn nhiều ạ !
 
Tải bộ cài phần mềm Dự toán GXD, Đấu thầu GXD, Thanh Quyết toán GXD, Quản lý chất lượng GXD. Dành cho người mua bản quyền
Phần mềm quản lý chất lượng công trình QLCL GXD
Kích để xem khóa học Dự toán công trình
Phần mềm Giải phóng mặt bằng GPMB GXD
Tìm hiểu khóa học Thanh Quyết toán GXD

Tìm thành viên

Dự thầu GXD