Lớp Quản lý chất lượng GXD
LH: Ms.Huyền Thanh 0985.099.938
Kích để đăng kí học online
Lớp Đo bóc, lập Dự toán
LH: Ms.Thu An 0975.381.900
Kích để đăng kí qua mạng
Lớp Dự toán dự thầu, đấu thầu
LH: Ms.Thanh Mai: 0974.889.500
Kích vào đây đăng kí học
Lớp Thanh quyết toán GXD
LH: Ms.Huyền Thanh 0985.099.938
Kích để đăng kí học online

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

bibobibo81

Thành viên mới
#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
#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
#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
#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
#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
#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
#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
#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
#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
 

daodinhdung

Thành viên sắp lên hạng rất nhiệt tình
#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.
 

thanhpc3idn

Thành viên mới
#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
 

xuantang88

Thành viên mới
#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
#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 ạ !