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

[Đã xong] Tính tổng diện tích các hình trên bản vẽ, "Ed" vào text sẵn có

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

cái nào nó cũng chạy được hết,mình text thử rồi,mà mình cũng dùng hằng ngày đấy mà,có thể nó báo cái lổi gì đấy bạn nói lổi mình sẽ hướng dẫn cho

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 ặc nhầm,để mình gởi lại file nha,mình gởi nhầm(http://www.cadviet.com/upfiles/2/progam05.rar),mọi ngưòi thử lại nha,tên lệnh là dt,dt0 giống nhử mình đã hướng dẫn ở trên nha

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

khó quá là khó chổ nào vậy bạn,để hướng dẩn nha:bạn quánh lệnh(dt hoặc dt0) đối với dt0 thì bấm vào vùng kín,dt thì bấm vào đường kép kín,nếu thấy hiện lên dòng chữ .....text<0> tức là không có chiều cao chử.quánh lệnh st để chỉnh chiều cao chữ,rồi ok thế là xong,

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

trước khi bạn nói lisp mình sai thì bạn phải kiểm tra lại trưóc khi đưa ra kết luận:giờ bạn mở acad ra và bạn vẽ một hình chữ nhật đúng 1m2 xem,sau đó dùng lệnh của mình,xem thử nó như thế nào,mình đã dùng cái lisp này để tính cho cả 100 ct rồi đấy bạn thử lại nha

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 bác Hoanh nhé, yêu cầu của em đã được đáp ứng. Diễn đàn Cadviet rất có ích cho những cư dân dùng AutoCad. Năm mới, em chúc bác mạnh khỏe, thành đạt và hạnh phúc trong cuộc sống.

chuc cả nhà mạnh khoẻ

cám ơn cad việt lần nữa

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

Chào bạn!

Lisp của bạn đưa ra rất tiện ích,nhưng trong công việc mịnh làm nhiều lúc cần phải nhân diện tích thực với một hệ số.Nên mình cần một lisp với như sau:

-Chọn hệ số n.

-Chọn vùng cần tính diện tích bằng cách ping điểm.

-ED kết quả vào text được chọ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
Lệnh UDT (Update diện tích) dưới đây sẽ làm điều bạn muốn:

(defun c:udt(/ ss tong ham tmp tt)
 (setq
   ss (ssget '((-4 . "")))	
   tong 0.0
   ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
   tmp (mapcar 'ham (ss2ent ss))  
   tt (entget (car (entsel "\nChon text ket qua: ")))
   tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
 )
 (entmod (subst (cons 1 tong) (assoc 1 tt) tt))
)

(defun ss2ent(ss / sodt index lstent)
 (setq 
   sodt (if ss (sslength ss) 0)	 
   index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
  index (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com)

Chào cao thủ Cadviet!

Lisp của bạn đưa ra rất tiện ích,nhưng trong công việc mình làm nhiều lúc cần phải nhân diện tích thực với một hệ số.Nên mình cần một lisp với như sau:

-Chọn hệ số n.

-Chọn vùng cần tính diện tích bằng cách ping điểm.

-ED kết quả vào text được chọn.

Rất mong pác giúp đỡ.thanks!

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
Lệnh UDT (Update diện tích) dưới đây sẽ làm điều bạn muốn:

(defun c:udt(/ ss tong ham tmp tt)
 (setq
   ss (ssget '((-4 . "")))	
   tong 0.0
   ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
   tmp (mapcar 'ham (ss2ent ss))  
   tt (entget (car (entsel "\nChon text ket qua: ")))
   tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
 )
 (entmod (subst (cons 1 tong) (assoc 1 tt) tt))
)

(defun ss2ent(ss / sodt index lstent)
 (setq 
   sodt (if ss (sslength ss) 0)	 
   index 0
 )
 (repeat sodt
   (setq ent (ssname ss index)
  index (1+ index)
  lstent (cons ent lstent)
   )
 )
 (reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com)

Mình không tải được.Link bị die rồi.Mình đang rất cần lisp này.Ai có upload giùm.Thanks

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
Lệnh UDT (Update diện tích) dưới đây sẽ làm điều bạn muốn:

Mình có thể thêm tuỳ chọn gì để thực hiện lệnh UDT liên tục ? Không cứ mỗi lần làm lại gõ UDT hơi mất time

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
Lisp này Tue_NV đã hoàn thành lại theo ý bạn PhuongAnh.

Có 2 lựa chọn cho bạn tính diện tích

1. Tính diện tích theo cách chọn đối tượng

2. Tính diện tích theo cách Pick điểm vào miền kín

Các bạn test lại xem nhé :

 

Command: udt : gõ lệnh udt

Kich thuoc cua chuong trinh tinh theo don vi mm

Nhap ti le chuyen doi don vi <0.001> :1/1000

 

Nhap So chu so thap phan <4> :2

 

Chon doi tuong de tinh dien tich hay Enter de tinh dien tich theo Pick diem

Select objects: -> Nếu ở dòng này bạn chọn đối tượng -> sẽ Tính diện tích theo cách chọn đối tượng

-> Nếu ở dòng này bạn nhấn Enter -> sẽ Tính diện tích theo cách Pick điểm vào miền kín

 

Code đây : http://www.cadviet.com/upfiles/2/udt.lsp

Lisp này rất hay,nhờ bác Tue sửa giùm bỏ chức năng chọn text kết quả mà nó sẽ tự hiện lên bảng kết quả diện tích và có luôn chu vi.Chân thành cảm ơn bác trướ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
Bác Tue và các cao thủ không giúp được e sao?

Chào bạn 790312,

Bạn là một thành viên có máu mặt của diễn đàn rồi mà sao bạn vẫn post bài như vầy, Bạn pót vầy thì ai mà giúp được. Bạn cần phải trình bày cụ thể hơn chứ.

Cái bảng mà bạn muốn hiện lên nó như thế nào???

Cái chu vi mà bạn nói là chu vi của từng vùng kín hay là tổng chu vi của các vùng???

Cái diện tích mà bạn muốn hiện ra là tổng diện tích như kết quả của lisp này hay là diện tich của từng vùng pick chọn???

Hãy trả lời hết các vấn đề nêu trên thì may ra mới có người giúp bạn được

Chào 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

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

Đây là lisp của bác Tue viết,lúc xuất ra kết quả thì yêu cầu chọn text để cho ra kết quả,mình thì muốn hiện ra bảng(bảng như thế nào cũng được) kết quả diện tích của từng pick chọn(hoặc đối tượng chọn) và chu vi của vùng pick chọn (hoặc đối tượng chọn)thôi.Xin lỗi vì diễn đạt không hết ý và cảm ơn sự góp ý của bạn.Thanks

  • 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

Ko biết mọi người thấy sao chứ lisp tính diện tích trên diễn đàn mình đều có thử cả và thấy có 1 vài nhược điểm nên chế ra cái này mọi người dùng thử nha.( Bản vẽ kĩ thuật thường là đơn vị mm tính kết quả ra đơn vị là m2).Lisp tính được với các bản vẽ tỉ lệ bất kì.Có thể tính tổng 1 lúc nhiều hình.Rất tiện khi tính đào và bóc khối lượng.

http://www.cadviet.com/upfiles/3/dti.lsp

;------------------------------------tinh dien tich (dti)-----------------------------------
(Defun c:dti()
(setvar "cmdecho" 0)
(initget "Heso Do")
(command "style" "DT" "vn-abc.shx" "" "0.8" "0.6" "" "" "")
       (if (not tpo) (setq tpo 1))
       (setq SC (getint (strcat "\n Nhap ti le <" (itoa tpo) "> :")))
       (if (not SC) (setq SC tpo) (setq tpo SC))
       (if (not tp1) (setq tp1 2))
       (setq tp (getint (strcat "\n Nhap So chu so thap phan <" (itoa tp1) "> :")))
       (if (not tp) (setq tp tp1) (setq tp1 tp))
(setq pt (getpoint "\n chon diem:"))
  	(if (= pt "Heso")
    	(progn	
		(setq am (getreal "\n loccoc259.co.cc : "))
		(if (and (null am) (/= ac 0))
			(setq am ac)
		)
	(setq pt (getpoint "\n Chon diem: "))	
	)
	(setq ac am))

(if (or (= am 0) (null am)) (setq am 1))
(setq s 0)
(progn 
;		(setq pt (getpoint "\n Chon diem: "))	
      (while pt
		(setq entold (cdr (assoc 5 (entget (entlast)))))
		(command "boundary" pt "")
		(setq entnew (cdr (assoc 5 (entget (entlast)))))
		(if (/= entold entnew)    
			(progn 
                       	(setq entnew (entget (entlast)))
                       	(if (assoc 62 entnew)
                         		(setq entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew)))) (assoc 62 entnew) entnew))
                         		(setq entnew (append entnew (list (cons 62 (+ 3 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 entnew))))))))))
                         	)			                          
                       	(entmod entnew)
                       	(Command "area" "o" (entlast))
				(setq s (+ s (getvar "area")))
  					(setq pt (getpoint "\n Chon diem: "))
				(entdel (entlast))
        		)
			(progn
				(princ "chon diem sai")
				(setq pt (getpoint "\n Chon diem: "))
			)
		)
	  )

           )

"(command "osnap" "intersection")"

(princ (* s am))
        (princ)
(command "style" "DT" "vn-abc.shx" "" "0.85" "0.6" "" "" "")
(setq pt1 (getpoint "Chon vi tri ghi dien tich: "))
(setq dt1 (* s am SC SC))
(setq dt (/ dt1 1000000))
(setq dt (strcat (rtos dt 2 tp)))
(command "text" pt1 2 0 (strcat dt))
)

Thấy hay thì nhớ thanks nha.

  • Vote tăng 5

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

Tks bạn đã đóng góp vào quỹ lisp 4room :")

Mình có 1 góp ý nhỏ nữa là nếu bạn đã cất công độ chế LISP và đã thành công rồi thì tại sao không đi thêm 1 bước nữa là nghiên cứu các cấu trúc lệnh của lisp nhỉ? Lúc đó kết quả sẽ không chỉ dừng lại ở việc "chế" nữa. Chúc bạn ngày càng phát triển khả năng và thành công

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ôi cũng không dùng được,không biết tại sao?hic

Nếu bạn không đưa ra được thông báo lúc sử dụng Lisp thì câu hỏi của bạn mãi mãi k có đáp á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

ặc ặc nhầm,để mình gởi lại file nha,mình gởi nhầm(http://www.cadviet.com/upfiles/2/progam05.rar),mọi ngưòi thử lại nha,tên lệnh là dt,dt0 giống nhử mình đã hướng dẫn ở trên nha

lisp của bác đuôi fas dùng thế nào vậ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

Nếu bạn không đưa ra được thông báo lúc sử dụng Lisp thì câu hỏi của bạn mãi mãi k có đáp án :)

bác ketxu post lại link lisp hoàn chỉnh được không?em down lisp udt.lisp về thì khi ap lên rồi mà gõ lệnh udt vẫn không nhận lệ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

Nguyên văn lisp "udt" ở bên trên, cũng không biết có phải lisp bạn đề cập không, cũng không rõ việc không nhận lệnh là như thế nào. Hy vọng bạn hiểu ý mình :)

(defun c:udt(/ ss tong ham tmp tt hstl oldim toe frome cur dt)
(prompt "\n Kich thuoc cua chuong trinh tinh theo don vi mm ")
(if (not hstlo) (setq hstlo 0.001))
(setq hstl (getreal (strcat "\n Nhap ti le chuyen doi don vi <" (rtos hstlo 2 3) "> :")))
(if (not hstl) (setq hstl hstlo) (setq hstlo hstl))
(if (not tpo) (setq tpo 2))
(setq tp (getint (strcat "\n Nhap So chu so thap phan <" (itoa tpo) "> :")))
(if (not tp) (setq tp tpo) (setq tpo tp))
(setq oldim (getvar "Dimzin"))
(setvar "Dimzin" 0) 
(prompt "\n Chon doi tuong de tinh dien tich hay Enter de tinh dien tich theo Pick diem ")
(setq
ss (ssget '((-4 . "<OR")(0 . "LWPOLYLINE")(0 . "REGION")(0 . "CIRCLE")(0 . "ARC")(-4 . "OR>"))) 
tong 0.0
ham (lambda (x) (command ".area" "o" x) (setq tong (+ tong (getvar "area"))))
tmp (mapcar 'ham (ss2ent ss)) 
)

(if (not ss) (progn
(setq tong 0.0 ss (ssadd))
(while (setq p (getpoint "\n Pick vao vung tinh dien tich :"))
(setq frome (entlast))
(command ".boundary" p "")
(setq toe (entlast))

(setq cur frome)
(while (not (eq cur toe))
(setq
cur (entnext cur)
ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area"))
(setq tong (+ tong dt))
)
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq tong (+ tong (* dt 2))) 
(sssetfirst ss ss)
)
(command "erase" ss "")
))


(setq tt (entget (car (entsel "\nChon text ket qua: ")))
tong (vl-string-right-trim "." (vl-string-right-trim "0" (rtos tong)))
)
(entmod (subst (cons 1 (rtos (* (atof tong) hstl hstl) 2 tp)) (assoc 1 tt) tt))

(setvar "Dimzin" oldim)


(princ)
)
;
(defun ss2ent(ss / sodt index lstent)
(setq 
sodt (if ss (sslength ss) 0) 
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ "\nUpdate Area - free lisp from cadviet.com")
(princ "\nUse UDT command to start!")
(vl-load-com)

  • 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

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

×