Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
girl

[yêu cầu] lisp tính ngược giá trị của mắt lưới san nền ?

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

girl    5

Em hay phải làm san nền bằng HS, nhiều khi chương trình bị lỗi, nó không điền hết giá trị của mắt lưới nên phải tính lại bằng tay. Em muốn nhờ CADVIET viết giúp em dòng lisp để làm công việc cụ thể như sau:

cụ thể khi chạy lisp như sau ạ :

Command: sn0

- Select text : sẽ tích vào các text có sẵn để lấy giá trị của nó (gọi là t1,t2,t3...) [có tối đa 3text]

- diện tích: tích vào text có sẵn để lấy giá trị diện tích (S)

- Khối lượng san nền : Tích vào text có sẵn để lấy giá trị (Q)

- Kết quả: chọn vào text để xuất kết quả:

KQ= [(Số đối tượng t1,t2,t3)*(Q)/(S)]-t1-t2-t3

ghi chú: (Số đối tượng t1,t2,t3) =1, nếu chỉ pick vào 1 text, =2 nếu pick vào 2 text; =3 nếu tích vào 3 text ở dòng "select text"

Em xin chân thành cảm ơ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
ketxu    2.652

Un-tested

 

(defun c:abc(/ e->v ct tm)(vl-load-com)
(setq e->v vlax-ename->vla-object ct (lambda(en)(atof(vla-get-textstring (e->v en))))
tm
((lambda(tl q s n / ss)(- (/ (* n q) s) tl))
 (apply '+ (mapcar 'ct (acet-ss-to-list (setq ss (ssget (list (cons 0 "*TEXT")))))))
 (ct (car (entsel "\nText khoi luong san nen :")))
 (ct (car (entsel "\nText dien tich :")))
 (sslength ss)
)
)
(vla-put-textstring (e->v (car(entsel "\nText ket qua :"))) tm)
(princ)
)

  • 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
girl    5

Xin lỗi các anh, em tưởng là em minh họa và đặt phép toán ra như vậy là đầy đủ rồi, nhưng vẫn làm các anh lập trình có đôi điều chưa hiểu. EM xin upload file CAD cụ thể minh họa yêu cầu của mình ạ. Anh KETXU đã viết giúp em rồi nhưng giá trị kết quả chưa đúng ạ. Em xin gửi anh file để anh hiểu rõ yêu cầu ạ. Anh chỉnh giúp em một chút nhé !

http://www.mediafire.com/?f4fj2wiq5g0j5ed

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
Skywings    46

@girl: đây là lisp mình viết lâu rùi, đáp ứng chính xác nhu cầu của bạn. (Trước đây mình cũng làm san nền, hay explode HS để chỉnh sửa ;) ).

(defun GET-TEXT ()
 (princ "\nChon cac cao trinh san lap <TEXT>: ")
 (while (null (setq Hsl (ssget '((0 . "TEXT")))))
(princ "\n**You selected NOTHING!**")
 )
)
(defun c:KLG (/ DT ENT HSL ID INDEX RESULT TXT VALUE)
 (GET-TEXT)
 (while (/= Hsl nil)
(while
 	(or (null
	(setq dt (car (entsel "\nDien tich o: ")))
  )
  (/= (cdr (assoc 0 (entget dt))) "TEXT")
  (null (numberp (read (cdr (assoc 1 (entget dt))))))
 	)
  	(princ "\nDien tich o: ")
)
(setq dt (atof (cdr (assoc 1 (entget dt)))))
(setq index 0
  id 0
  result 0
)
(princ "\n>>Expression: (")
(repeat (sslength Hsl)
 	(setq ent   (entget (ssname Hsl index))
	value (read (cdr (assoc 1 ent)))
	index (1+ index)
 	)
 	(if (numberp value)
(progn
  (setq result (+ result value)
 id 	(1+ id)
  )
  (if (/= index 1)
	(princ " + ")
  )
  (princ (rtos value 2 2))
)
 	)
)
(setq result (/ (float result) id))
(princ (strcat ") / " (rtos id 2 0)))
(princ (strcat "\n>>Htb = " (rtos result 2 2)))
(princ (strcat "\nDien tich = " (rtos dt 2 2)))
(setq result (* result dt))
(princ (strcat "\n>>Volumn = " (rtos result 2 2)))
(while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
 	(princ "\n**You selected NOTHING!**")
)
(setq txt (entget (car txt))
  txt (subst (cons 1 (rtos result 2 2)) (assoc 1 txt) txt)
)
(entmod txt)
(setq Hsl (ssget '((0 . "TEXT"))))
 )
 (princ)
)

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
girl    5

Xin lỗi bạn Skywings, cái KLG của bạn là cái lisp tính thuận, Cái đó mình có rồi. Còn ở đây là bài toán ngược, tính ngược lại giá trị mắt lưới mà bạn . hi. Cảm ơn bạn quan tâm

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
Skywings    46

ui sr, ko đọc kỹ đề bài ^^! Edit ...

(defun GET-TEXT ()
 (princ "\nChon cac cao trinh san lap <TEXT>: ")
 (while (null (setq Hsl (ssget '((0 . "TEXT")))))
(princ "\n**You selected NOTHING!**")
 )
)
(defun c:KLG1 (/ DT ENT HSL ID INDEX RESULT TXT VALUE KL)
 (GET-TEXT)
 (while (/= Hsl nil)
(while
 	(or (null
	(setq dt (car (entsel "\nDien tich o: ")))
  )
  (/= (cdr (assoc 0 (entget dt))) "TEXT")
  (null (numberp (read (cdr (assoc 1 (entget dt))))))
 	)
  	(princ "\nDien tich o: ")
)
(while
 	(or (null
	(setq kl (car (entsel "\nKhoi luong: ")))
  )
  (/= (cdr (assoc 0 (entget kl))) "TEXT")
  (null (numberp (read (cdr (assoc 1 (entget kl))))))
 	)
  	(princ "\nKhoi luong: ")
)
(setq dt (atof (cdr (assoc 1 (entget dt)))))
(setq kl (atof (cdr (assoc 1 (entget kl)))))
(setq index 0
  id 0
  result 0
)
(repeat (sslength Hsl)
 	(setq ent   (entget (ssname Hsl index))
	value (read (cdr (assoc 1 ent)))
	index (1+ index)
 	)
 	(if (numberp value)
  (setq result (+ result value)
 id 	(1+ id)
  )
 	)
)
(setq result (- (/ (*  kl (1+ id)) dt) result))
(while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
 	(princ "\n**You selected NOTHING!**")
)
(setq txt (entget (car txt))
  txt (subst (cons 1 (rtos result 2 2)) (assoc 1 txt) txt)
)
(entmod txt)
(setq Hsl (ssget '((0 . "TEXT"))))
 )
 (princ)
)

Chỉnh sửa theo Skywings

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
ketxu    2.652

Xin lỗi các anh, em tưởng là em minh họa và đặt phép toán ra như vậy là đầy đủ rồi, nhưng vẫn làm các anh lập trình có đôi điều chưa hiểu. EM xin upload file CAD cụ thể minh họa yêu cầu của mình ạ. Anh KETXU đã viết giúp em rồi nhưng giá trị kết quả chưa đúng ạ. Em xin gửi anh file để anh hiểu rõ yêu cầu ạ. Anh chỉnh giúp em một chút nhé !

http://www.mediafire...f4fj2wiq5g0j5ed

Mình đang dùng máy không có CAD ở đây, hôm qua viết cho bạn bằng máy này cũng k test được.Nếu vẫn ra kết quả mà sai thì chắc là do công thức mình hoặc bạn đặt nhầm - hoặc bạn tick nhầm thôi, hướng thì vẫn thế, các bác trên này sẽ giúp bạn.Goodluck :)

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
ketxu    2.652

Theo ảnh thì hôm qua bạn yêu cầu sai !

Khi B là ẩn số, số text bạn có thể chọn bây giờ chỉ là 2 (B có đâu mà chọn bạn, nó đang là ẩn (và là 1 số chưa chính xác) mà ?), và như vậy thì bài toán chuyển thành chọn 2 text A,C, chọn Q, chọn S => B. Số đối tượng cần nhân là n+1

Nếu ketxu suy luận đúng thì bạn sửa dòng (sslength ss) thành (1+ (sslength ss)) là đượ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
girl    5

Trong ảnh Có 2 trường hợp mà anh. 1 trường hợp là khi mình select text có 2 text được chọn và 1 trường hợp là có 3 text được chọn. Em yêu cầu đúng mà. hic

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
ketxu    2.652

2 text chọn thì số đối tượng cần chia là 3. 3 text chọn thì chia cho 4. Khác hẳn với yêu cầu đầu - bạn đọc lại 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
girl    5

à. đúng rùi. hì. Em hiểu nhầm chỗ đó. hi.Cái này là do trình em còn non nên em hiểu sai thôi ạ ?xin lỗi anh nhé ! em xin rút kinh nghiệm lần sau sẽ post ảnh minh họa lên ngay từ đầ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
girl    5

Em sửa được trong trường hợp có 3 text được chọn thì lisp chạy đúng rồi. Nhưng trong trường hợp 2 text được chọn thì chạy sai, em không hiểu được. hic. Các anh sửa giúp em trường hợp có 2 text được chọn [KQ=3*Q/S-a-c] nhé !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66427&hl=&fromsearch=1
(defun c:abc(/ e->v ct tm)(vl-load-com)
(setq e->v vlax-ename->vla-object ct (lambda(en)(atof(vla-get-textstring (e->v en))))
tm
((lambda(tl q s n / ss)(- (/ (* (+ 1 n) q) s) tl))
 (apply '+ (mapcar 'ct (acet-ss-to-list (setq ss (ssget (list (cons 0 "*TEXT")))))))
 (ct (car (entsel "\nText khoi luong san nen :")))
 (ct (car (entsel "\nText dien tich :")))
 (sslength ss)
)
)
(vla-put-textstring (e->v (car(entsel "\nText ket qua :"))) tm)
(princ)
)

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
aliosa    4

Nếu viết được chương trình cho phép chọn cả vùng đã san nền. Chỗ nào sai đánh dấu (tô màu, vẽ ghi chú) để chỉnh sửa lại thì hay. Chọn thủ công thì vất vả đôi khi không xác định chính xác chỗ sai.

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
tientracdia    11

ui sr, ko đọc kỹ đề bài ^^! Edit ...

(defun GET-TEXT ()
 (princ "\nChon cac cao trinh san lap <TEXT>: ")
 (while (null (setq Hsl (ssget '((0 . "TEXT")))))
(princ "\n**You selected NOTHING!**")
 )
)
(defun c:KLG1 (/ DT ENT HSL ID INDEX RESULT TXT VALUE KL)
 (GET-TEXT)
 (while (/= Hsl nil)
(while
 	(or (null
(setq dt (car (entsel "\nDien tich o: ")))
  )
  (/= (cdr (assoc 0 (entget dt))) "TEXT")
  (null (numberp (read (cdr (assoc 1 (entget dt))))))
 	)
  	(princ "\nDien tich o: ")
)
(while
 	(or (null
(setq kl (car (entsel "\nKhoi luong: ")))
  )
  (/= (cdr (assoc 0 (entget kl))) "TEXT")
  (null (numberp (read (cdr (assoc 1 (entget kl))))))
 	)
  	(princ "\nKhoi luong: ")
)
(setq dt (atof (cdr (assoc 1 (entget dt)))))
(setq kl (atof (cdr (assoc 1 (entget kl)))))
(setq index 0
  id 0
  result 0
)
(repeat (sslength Hsl)
 	(setq ent   (entget (ssname Hsl index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
 	)
 	(if (numberp value)
  (setq result (+ result value)
 id 	(1+ id)
  )
 	)
)
(setq result (- (/ (*  kl (1+ id)) dt) result))
(while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
 	(princ "\n**You selected NOTHING!**")
)
(setq txt (entget (car txt))
  txt (subst (cons 1 (rtos result 2 2)) (assoc 1 txt) txt)
)
(entmod txt)
(setq Hsl (ssget '((0 . "TEXT"))))
 )
 (princ)
)

@girl: đây là lisp mình viết lâu rùi, đáp ứng chính xác nhu cầu của bạn. (Trước đây mình cũng làm san nền, hay explode HS để chỉnh sửa ;) ).

(defun GET-TEXT ()
 (princ "\nChon cac cao trinh san lap <TEXT>: ")
 (while (null (setq Hsl (ssget '((0 . "TEXT")))))
(princ "\n**You selected NOTHING!**")
 )
)
(defun c:KLG (/ DT ENT HSL ID INDEX RESULT TXT VALUE)
 (GET-TEXT)
 (while (/= Hsl nil)
(while
 	(or (null
(setq dt (car (entsel "\nDien tich o: ")))
  )
  (/= (cdr (assoc 0 (entget dt))) "TEXT")
  (null (numberp (read (cdr (assoc 1 (entget dt))))))
 	)
  	(princ "\nDien tich o: ")
)
(setq dt (atof (cdr (assoc 1 (entget dt)))))
(setq index 0
  id 0
  result 0
)
(princ "\n>>Expression: (")
(repeat (sslength Hsl)
 	(setq ent   (entget (ssname Hsl index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
 	)
 	(if (numberp value)
(progn
  (setq result (+ result value)
 id 	(1+ id)
  )
  (if (/= index 1)
(princ " + ")
  )
  (princ (rtos value 2 2))
)
 	)
)
(setq result (/ (float result) id))
(princ (strcat ") / " (rtos id 2 0)))
(princ (strcat "\n>>Htb = " (rtos result 2 2)))
(princ (strcat "\nDien tich = " (rtos dt 2 2)))
(setq result (* result dt))
(princ (strcat "\n>>Volumn = " (rtos result 2 2)))
(while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
 	(princ "\n**You selected NOTHING!**")
)
(setq txt (entget (car txt))
  txt (subst (cons 1 (rtos result 2 2)) (assoc 1 txt) txt)
)
(entmod txt)
(setq Hsl (ssget '((0 . "TEXT"))))
 )
 (princ)
)

;;;-----------------------------

Mình nhờ các Anh chỉnh giúp mình để chỉnh Lisp trên để thực hiện tính chênh cao trung bình các ô lưới :

1. Chọn các text Chênh cao trung bình, xong enter chọn text thay thế nếu chưa có thì ghi kết quả CCTB tại điểm chọn và ghi nhớ nó,

2. Tiếp chọn Text Diện tích, thực hiện phép tính ( CCTB*Diện tích= Khối lượng )

3. Chọn text ghi thay thế Khối lượng, nếu chưa có thì ghi vào điểm chọn.

Rất Mong được các anh 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
hiepttr    523

Em sửa được trong trường hợp có 3 text được chọn thì lisp chạy đúng rồi. Nhưng trong trường hợp 2 text được chọn thì chạy sai, em không hiểu được. hic. Các anh sửa giúp em trường hợp có 2 text được chọn [KQ=3*Q/S-a-c] nhé !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66427&hl=&fromsearch=1
(defun c:abc(/ e->v ct tm)(vl-load-com)
(setq e->v vlax-ename->vla-object ct (lambda(en)(atof(vla-get-textstring (e->v en))))
tm
((lambda(tl q s n / ss)(- (/ (* (+ 1 n) q) s) tl))
 (apply '+ (mapcar 'ct (acet-ss-to-list (setq ss (ssget (list (cons 0 "*TEXT")))))))
 (ct (car (entsel "\nText khoi luong san nen :")))
 (ct (car (entsel "\nText dien tich :")))
 (sslength ss)
)
)
(vla-put-textstring (e->v (car(entsel "\nText ket qua :"))) tm)
(princ)
)

Mình nghỉ rằng lisp chạy đúng --- còn bạn thì chạy sai.... hic...

Vì khi bạn chia được mảnh đất là tứ giác thì tính khối lượng theo chiều cao đào đắp trung bình sẽ cho kết quả chấp nhận được

Nhưng khi mảnh đất bạn chia ra có hình tam giác thì tính khối lượng theo chiều cao đào đắp trung bình sẽ cho kết quả sai bé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

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


×