Đến nội dung


Hình ảnh
- - - - -

[Đã xong] lisp về DIỆN TÍCH


  • Please log in to reply
10 replies to this topic

#1 thietke

thietke

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 16 June 2011 - 11:45 AM

Nhờ các bác viết hộ em cái lisp này với.
Tính diện tích bằng cách hatch vào các vùng kín sau đó cộng,trừ,nhân,chia cho một số bằng cách nhập từ bàn phím hoặc cộng,trừ,nhân,chia với một text có sẵn trên cad sau đó lấy kết quả edit vào text có sẵn.
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 16 June 2011 - 11:52 AM

Nhờ các bác viết hộ em cái lisp này với.
Tính diện tích bằng cách hatch vào các vùng kín sau đó cộng,trừ,nhân,chia cho một số bằng cách nhập từ bàn phím hoặc cộng,trừ,nhân,chia với một text có sẵn trên cad sau đó lấy kết quả edit vào text có sẵn.

Bạn dùng CAD mấy nhỉ ??
Thao tác Hatch là ai làm nhỉ ?? Bạn hay máy.
Lisp chạy xong thì Hatch còn giữ lại không nhỉ ??

Tiện thể nhắc bạn luôn về cách đặt tiêu đề topic, vừa nãy mình xóa bài của bạn đi nhưng chưa kịp gửi tin ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 thietke

thietke

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 16 June 2011 - 02:19 PM

Bạn dùng CAD mấy nhỉ ??
Thao tác Hatch là ai làm nhỉ ?? Bạn hay máy.
Lisp chạy xong thì Hatch còn giữ lại không nhỉ ??

Tiện thể nhắc bạn luôn về cách đặt tiêu đề topic, vừa nãy mình xóa bài của bạn đi nhưng chưa kịp gửi tin ^^

Mình dùng cad 2007.Lisp chay xong thi không cần giữ lại hatch nữa,hatch để biết là nhưng vùng đã kích vô tính diện tích.
Lisp của mình nói chung yêu cầu như vậy:
Nhập lệnh Lisp:
-lisp hỏi nhập tỷ lệ bản vẽ,số sau dấu phẩy.
-Kích vô những vùng cần tính diện tích (thể hiện hatch để biết những vùng đã kích vô rồi tính xong không giữ lại hatch nữa)sau đó enter lisp hỏi
cộng ,trừ ,nhân, chia ví dụ đánh lệnh cộng lisp sẽ hỏi tiếp là nhập số từ bàn phím hay chọn text có sẵn trên bản vẽ.
-Kết thúc kết quả được edit vào một text có sẵn trên bản vẽ.
Nếu bạn viết thêm một bước như vậy thì hay:Sau khi thực hiện được một lần muốn lập lại các thao tác như lần trước thì chỉ cần bấm một lệnh là được khồng cần lập lại các thao tác ban đầu cho đỡ mât thời gian.Còn nếu có thay đổi thì lisp sẽ hỏi.
Thank bạn.
  • 0

#4 thietke

thietke

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 17 June 2011 - 09:32 AM

Mình dùng cad 2007.Lisp chay xong thi không cần giữ lại hatch nữa,hatch để biết là nhưng vùng đã kích vô tính diện tích.
Lisp của mình nói chung yêu cầu như vậy:
Nhập lệnh Lisp:
-lisp hỏi nhập tỷ lệ bản vẽ,số sau dấu phẩy.
-Kích vô những vùng cần tính diện tích (thể hiện hatch để biết những vùng đã kích vô rồi tính xong không giữ lại hatch nữa)sau đó enter lisp hỏi
cộng ,trừ ,nhân, chia ví dụ đánh lệnh cộng lisp sẽ hỏi tiếp là nhập số từ bàn phím hay chọn text có sẵn trên bản vẽ.
-Kết thúc kết quả được edit vào một text có sẵn trên bản vẽ.
Nếu bạn viết thêm một bước như vậy thì hay:Sau khi thực hiện được một lần muốn lập lại các thao tác như lần trước thì chỉ cần bấm một lệnh là được khồng cần lập lại các thao tác ban đầu cho đỡ mât thời gian.Còn nếu có thay đổi thì lisp sẽ hỏi.
Thank bạn.

Bác Ketxu giúp mình với :rolleyes:
  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 17 June 2011 - 10:59 AM

Bác Ketxu giúp mình với :rolleyes:

Trên diễn đàn có rất nhiều người mà, mình hỏi lại ý bạn để mọi người cùng giúp bạn dễ hơn thôi, chứ đâu có phải mình có khả năng giải quyết nó. Yêu cầu của bạn nên tách ra làm 4 lệnh thì dễ hơn, ví dụ h+,h-,h*,h: :)
Mình đang bận, với lại chưa chắc viết được, nên đành ngồi hóng cùng bạn thôi ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#6 thietke

thietke

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 17 June 2011 - 02:06 PM

Mình dùng cad 2007.Lisp chay xong thi không cần giữ lại hatch nữa,hatch để biết là nhưng vùng đã kích vô tính diện tích.
Lisp của mình nói chung yêu cầu như vậy:
Nhập lệnh Lisp:
-lisp hỏi nhập tỷ lệ bản vẽ,số sau dấu phẩy.
-Kích vô những vùng cần tính diện tích (thể hiện hatch để biết những vùng đã kích vô rồi tính xong không giữ lại hatch nữa)sau đó enter lisp hỏi
cộng ,trừ ,nhân, chia ví dụ đánh lệnh cộng lisp sẽ hỏi tiếp là nhập số từ bàn phím hay chọn text có sẵn trên bản vẽ.
-Kết thúc kết quả được edit vào một text có sẵn trên bản vẽ.
Nếu bạn viết thêm một bước như vậy thì hay:Sau khi thực hiện được một lần muốn lập lại các thao tác như lần trước thì chỉ cần bấm một lệnh là được khồng cần lập lại các thao tác ban đầu cho đỡ mât thời gian.Còn nếu có thay đổi thì lisp sẽ hỏi.

Có bạn nào ở diễn đàn giúp mình với được không,mình đang cần gấp.Thank all :rolleyes:

Trên diễn đàn có rất nhiều người mà, mình hỏi lại ý bạn để mọi người cùng giúp bạn dễ hơn thôi, chứ đâu có phải mình có khả năng giải quyết nó. Yêu cầu của bạn nên tách ra làm 4 lệnh thì dễ hơn, ví dụ h+,h-,h*,h: :)
Mình đang bận, với lại chưa chắc viết được, nên đành ngồi hóng cùng bạn thôi ^^

Tách thành mấy lệnh cũng được bạn :wacko:
  • 0

#7 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 17 June 2011 - 05:34 PM

Có bạn nào ở diễn đàn giúp mình với được không,mình đang cần gấp.Thank all :rolleyes:


Tách thành mấy lệnh cũng được bạn :wacko:


- Chào bạn thietke.
Mình viết giúp bạn lisp này. Bạn dùng thử có đúng ý bạn không?
Bạn lưu ý mấy vấn đề:
1. Yêu cầu nhập bao nhiêu số lẻ trong kết quả thì mình chọn luôn là 2 số lẻ luôn (Vì phổ biến).
2. Khi xuất kết quả có 2 sự lựa chọn cho bạn.
+ Chọn W (write) để viết kết quả ra. Sẽ cho bạn text mới
+ Chọn P (Paste) để dán kết quả vào text có sẵn (Như yêu cầu của bạn)
3. Lisp này không phải tách lệnh mà bạn sẽ lựa chọn công trừ nhân chia...
4. Mình chưa check đâu nhé. Bạn phải kiểm tra lại

(defun CheckObj (e funnam) (if (eq (cdr (assoc 0 (entget e))) funnam) T nil))
(defun PasRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\nSelect a text to paste result:")))
(if (CheckObj e "TEXT") (setq OK T) (alert "\nFunction only for TEXT object."))
)
(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun WriRes(kq / pt)
(if (not h0) (setq h0 2.0))
(setq h (getreal (strcat "\nInput height of result text <" (rtos h0 2 1) ">")))
(if (not h) (setq h h0) (setq h0 h))
(setq pt (getpoint "\nPick point of text result:"))
(if (not (tblsearch "Style" "DBD_TXT")) (command "-style" "DBD_TXT" "Vnsimple" "" "0.7" "" "" "" ""))
(if (not (tblsearch "Layer" "DBD_TXT")) (Command "Layer" "N" "DBD_TXT" "C" "Magenta" "DBD_TXT" ""))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos kq 2 2)) (cons 40 h) (cons 41 0.7) (cons 10 pt) (cons 72 1) (cons 11 pt) (cons 73 2) (cons 8 "DBD_TXT") (cons 7 "DBD_TXT") (cons 62 6)))
(princ)
)
;;;-----------------------------------------
(defun OutPutRes(kq)
(if (not key1) (setq key1 "P"))
(initget "p w ")
(setq key (getkword (strcat "\Paste result on a existing text/Write result [P/W] <" key1 ">: ")))
(if (not key) (setq key key1) (setq key1 key))
(if (= (strcase key) "P") (PasRes kq))
(if (= (strcase key) "W") (WriRes kq))
)
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)
(defun c:dt()
(setq sca1 1.0)
(setq sca (getreal (strcat "\nNhap ty le <" (rtos sca1 2 2) ">:")))
(if (not sca)
(setq sca sca1)
(setq sca1 sca)
)
(setq suma 0 ss_del (ssadd) pt nil)
(while (setq pt (getpoint "Pick point"))
(command "-boundary" "A" "" pt "")
(setq obj (entlast))
(command ".area" "o" obj)
(setq suma (+ suma (getvar "area")))
(command "-hatch" pt "")
(setq ss_del (ssadd (entlast) ss_del))
)
(setq kq (* sca suma))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(if (not sohang0) (setq sohang0 0.00))
(setq sohang (getreal (strcat "\nInput number to cong tru nhan chia <" (rtos sohang0 2 2) ">:")))
(if (not sohang)
(setq sohang sohang0)
(setq sohang0 sohang)
)
(setq kq (congtrunhanchia key_ctnc kq sohang))
(command "erase" ss_del "")
(OutPutRes kq)
(princ "\nWirrten by hochoaivandot-www.Cadviet.com")
(princ)
)
Chúc bạn may mắn!
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#8 thietke

thietke

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 17 June 2011 - 09:42 PM

- Chào bạn thietke.
Mình viết giúp bạn lisp này. Bạn dùng thử có đúng ý bạn không?
Bạn lưu ý mấy vấn đề:
1. Yêu cầu nhập bao nhiêu số lẻ trong kết quả thì mình chọn luôn là 2 số lẻ luôn (Vì phổ biến).
2. Khi xuất kết quả có 2 sự lựa chọn cho bạn.
+ Chọn W (write) để viết kết quả ra. Sẽ cho bạn text mới
+ Chọn P (Paste) để dán kết quả vào text có sẵn (Như yêu cầu của bạn)
3. Lisp này không phải tách lệnh mà bạn sẽ lựa chọn công trừ nhân chia...
4. Mình chưa check đâu nhé. Bạn phải kiểm tra lại


(defun CheckObj (e funnam) (if (eq (cdr (assoc 0 (entget e))) funnam) T nil))
(defun PasRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\tSelect a text to paste result:")))
(if (CheckObj e "TEXT") (setq OK T) (alert "\nFunction only for TEXT object."))
)
(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun WriRes(kq / pt)
(if (not h0) (setq h0 2.0))
(setq h (getreal (strcat "\nInput height of result text <" (rtos h0 2 1) ">")))
(if (not h) (setq h h0) (setq h0 h))
(setq pt (getpoint "\tPick point of text result:"))
(if (not (tblsearch "Style" "DBD_TXT")) (command "-style" "DBD_TXT" "Vnsimple" "" "0.7" "" "" "" ""))
(if (not (tblsearch "Layer" "DBD_TXT")) (Command "Layer" "N" "DBD_TXT" "C" "Magenta" "DBD_TXT" ""))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos kq 2 2)) (cons 40 h) (cons 41 0.7) (cons 10 pt) (cons 72 1) (cons 11 pt) (cons 73 2) (cons 8 "DBD_TXT") (cons 7 "DBD_TXT") (cons 62 6)))
(princ)
)
;;;-----------------------------------------
(defun OutPutRes(kq)
(if (not key1) (setq key1 "P"))
(initget "p w ")
(setq key (getkword (strcat "\Paste result on a existing text/Write result [P/W] <" key1 ">: ")))
(if (not key) (setq key key1) (setq key1 key))
(if (= (strcase key) "P") (PasRes kq))
(if (= (strcase key) "W") (WriRes kq))
)
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)
(defun c:dtdt()
(setq sca1 1.0)
(setq sca (getreal (strcat "\nNhap ty le <" (rtos sca1) ">:")))
(if (not sca)
(setq sca sca1)
(setq sca1 sca)
)
(setq suma 0 ss_del (ssadd) pt nil)
(while (setq pt (getpoint "Pick point"))
(command "-boundary" "A" "" pt "")
(setq obj (entlast))
(command ".area" "o" obj)
(setq suma (+ suma (getvar "area")))
(command "-hatch" pt "")
(setq ss_del (ssadd (entlast) ss_del))
)
(setq kq (* sca suma))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(if (not sohang0) (setq sohang0 0.00))
(setq sohang (getreal (strcat "\nInput number to cong tru nhan chia <" (rtos sohang0) ">:")))
(if (not sohang)
(setq sohang sohang0)
(setq sohang0 sohang)
)
(setq kq (congtrunhanchia key_ctnc kq sohang))
(command "erase" ss_del "")
(OutPutRes kq)
(princ "\nWirrten by hochoaivandot-www.Cadviet.com")
(princ)
)
P/S chúc bạn may mắn!


Cảm ơn bạn nhiều.Lisp của bạn chạy rất ổn định nhưng nhờ bạn viết them một tý nữa là tuyệt.Lúc cộng trừ nhân chia mình không nhập số từ bàn phím mà mình chọn text có sẵn trên cad luôn được không bạn rồi sau đó edit vào text có sẵn.Cái này bạn có thể viết 1 lisp khác hoặc gộp chung vào lisp trước cũng được(lúc cộng trừ nhân chia lisp sẽ hỏi là chon text hoặc nhập số) .
Á bạn có thể bỏ bước ra kết quả không cần hỏi p hoặc w mà mình muốn edit luôn vào text có sẵn để mất thời gian vì thao tác nhiều.
Thank bạn.
  • 0

#9 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 17 June 2011 - 11:37 PM

Cảm ơn bạn nhiều.Lisp của bạn chạy rất ổn định nhưng nhờ bạn viết them một tý nữa là tuyệt.Lúc cộng trừ nhân chia mình không nhập số từ bàn phím mà mình chọn text có sẵn trên cad luôn được không bạn rồi sau đó edit vào text có sẵn.Cái này bạn có thể viết 1 lisp khác hoặc gộp chung vào lisp trước cũng được(lúc cộng trừ nhân chia lisp sẽ hỏi là chon text hoặc nhập số) .
Á bạn có thể bỏ bước ra kết quả không cần hỏi p hoặc w mà mình muốn edit luôn vào text có sẵn để mất thời gian vì thao tác nhiều.
Thank bạn.

Chào thietke!
Đây là lisp thực hiện yêu cầu của bạn

(defun CheckObj (e funnam) (if (eq (cdr (assoc 0 (entget e))) funnam) T nil))
(defun PasRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\nSelect a text to paste result:")))
(if (CheckObj e "TEXT") (setq OK T) (alert "\nFunction only for TEXT object."))
)
(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))
(princ)
)
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)
(defun c:dt2(/ sca suma ss_del obj kq key_ctnc en OK sohang)
(setq sca1 1.0)
(setq sca (getreal (strcat "\nNhap ty le <" (rtos sca1) ">:")))
(if (not sca)
(setq sca sca1)
(setq sca1 sca)
)
(setq suma 0 ss_del (ssadd) pt nil)
(while (setq pt (getpoint "Pick point"))
(command "-boundary" "A" "" pt "")
(setq obj (entlast))
(command ".area" "o" obj)
(setq suma (+ suma (getvar "area")))
(command "-hatch" pt "")
(setq ss_del (ssadd (entlast) ss_del))
)
(setq kq (* sca suma))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(setq OK nil)
(while (not OK)
(setq en (car (entsel "\nSelect a text to congtrunhanchia")))
(if (CheckObj en "TEXT") (setq OK T) (alert "\nFunction only for TEXT object."))
)
(setq sohang (atof (cdr (assoc 1 (entget en)))))
(setq kq (congtrunhanchia key_ctnc kq sohang))
(command "erase" ss_del "")
(PasRes kq)
(princ "\nWirrten by hochoaivandot-www.Cadviet.com")
(princ)
)
P/S: Rất vui vì có thể giúp được bạn...
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#10 thietke

thietke

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 18 June 2011 - 09:03 AM

Chào thietke!
Đây là lisp thực hiện yêu cầu của bạn


(defun CheckObj (e funnam) (if (eq (cdr (assoc 0 (entget e))) funnam) T nil))
(defun PasRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\nSelect a text to paste result:")))
(if (CheckObj e "TEXT") (setq OK T) (alert "\nFunction only for TEXT object."))
)
(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))
(princ)
)
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)
(defun c:dt2(/ sca suma ss_del obj kq key_ctnc en OK sohang)
(setq sca1 1.0)
(setq sca (getreal (strcat "\nNhap ty le <" (rtos sca1) ">:")))
(if (not sca)
(setq sca sca1)
(setq sca1 sca)
)
(setq suma 0 ss_del (ssadd) pt nil)
(while (setq pt (getpoint "Pick point"))
(command "-boundary" "A" "" pt "")
(setq obj (entlast))
(command ".area" "o" obj)
(setq suma (+ suma (getvar "area")))
(command "-hatch" pt "")
(setq ss_del (ssadd (entlast) ss_del))
)
(setq kq (* sca suma))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(setq OK nil)
(while (not OK)
(setq en (car (entsel "\nSelect a text to congtrunhanchia")))
(if (CheckObj en "TEXT") (setq OK T) (alert "\nFunction only for TEXT object."))
)
(setq sohang (atof (cdr (assoc 1 (entget en)))))
(setq kq (congtrunhanchia key_ctnc kq sohang))
(command "erase" ss_del "")
(PasRes kq)
(princ "\nWirrten by hochoaivandot-www.Cadviet.com")
(princ)
)
P/S: Rất vui vì có thể giúp được bạn...

Lisp của bạn chạy rất ổn định.Thank bạn nhiều.
  • 1

#11 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 18 June 2011 - 04:19 PM

Cảm ơn bạn nhiều.Lisp của bạn chạy rất ổn định nhưng nhờ bạn viết them một tý nữa là tuyệt.Lúc cộng trừ nhân chia mình không nhập số từ bàn phím mà mình chọn text có sẵn trên cad luôn được không bạn rồi sau đó edit vào text có sẵn.Cái này bạn có thể viết 1 lisp khác hoặc gộp chung vào lisp trước cũng được(lúc cộng trừ nhân chia lisp sẽ hỏi là chon text hoặc nhập số) .
Á bạn có thể bỏ bước ra kết quả không cần hỏi p hoặc w mà mình muốn edit luôn vào text có sẵn để mất thời gian vì thao tác nhiều.
Thank bạn.

Hề hề hề,
Mạn phép bạn hochoaihetdot mình sửa cái lisp của bạn theo yêu cầu của bạn thietke nha. Nhắc bạn chút là nếu tỷ lệ bản vẽ là a thì tỷ lệ giữa diện tich thật với diện tích trên bản vẽ sẽ là bình phương của a chứ không phải chỉ là a đâu bạn nhé.
Đây là cái lisp mình đã sửa. Hy vọng bạn thietke hài lòng.


(defun CheckObj (e funnam) (if (eq (cdr (assoc 0 (entget e))) funnam) T nil))
(defun PasRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\tSelect a text to paste result:")))
(if (CheckObj e "TEXT") (setq OK T) (alert "\nFunction only for TEXT object."))
)
(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun WriRes(kq / pt)
(if (not h0) (setq h0 2.0))
(setq h (getreal (strcat "\nInput height of result text <" (rtos h0 2 1) ">")))
(if (not h) (setq h h0) (setq h0 h))
(setq pt (getpoint "\tPick point of text result:"))
(if (not (tblsearch "Style" "DBD_TXT")) (command "-style" "DBD_TXT" "Vnsimple" "" "0.7" "" "" "" ""))
(if (not (tblsearch "Layer" "DBD_TXT")) (Command "Layer" "N" "DBD_TXT" "C" "Magenta" "DBD_TXT" ""))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos kq 2 2)) (cons 40 h) (cons 41 0.7) (cons 10 pt) (cons 72 1) (cons 11 pt) (cons 73 2) (cons 8 "DBD_TXT") (cons 7 "DBD_TXT") (cons 62 6)))
(princ)
)
;;;-----------------------------------------
(defun OutPutRes(kq)
(if (not key1) (setq key1 "P"))
;;;;(initget "p w ")
;;;;(setq key (getkword (strcat "\Paste result on a existing text/Write result [P/W] <" key1 ">: ")))
(if (not key) (setq key key1) (setq key1 key))
(if (= (strcase key) "P") (PasRes kq))
(if (= (strcase key) "W") (WriRes kq))
)
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)
(defun c:dtdt(/ sca suma ss_del obj kq key_ctnc sohang chon)
(setq sca1 1.0)
(setq sca (getreal (strcat "\nNhap ty le <" (rtos sca1) ">:")))
(if (not sca)
(setq sca sca1)
(setq sca1 sca)
)
(setq suma 0 ss_del (ssadd) pt nil)
(while (setq pt (getpoint "Pick point"))
(command "-boundary" "A" "" pt "")
(setq obj (entlast))
(command ".area" "o" obj)
(setq suma (+ suma (getvar "area")))
(command "-hatch" pt "")
(setq ss_del (ssadd (entlast) ss_del))
)
(setq kq (* sca sca suma))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(if (not sohang0) (setq sohang0 0.00))
(setq chon (getstring t "\n Chon so hang <y or n> : "))
(if (= (strcase chon) "Y")
(setq sohang (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text gia tri muon tinh")))))))
(setq sohang (getreal (strcat "\nInput number to cong tru nhan chia <" (rtos sohang0) ">:")))
)
(if (not sohang)
(setq sohang sohang0)
(setq sohang0 sohang)
)
(setq kq (congtrunhanchia key_ctnc kq sohang))
(command "erase" ss_del "")
(OutPutRes kq)
(princ "\nWirrten by hochoaivandot-www.Cadviet.com")
(princ)
)

Chúc các bạn vui.
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.