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

Tháng 9 17, 2012

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 !

Tháng 9 17, 2012

Bạn nên đưa bản vẽ lên, trong đó mô tả rõ trước và sau khi chạy lisp cùng các trường hợp có thể xảy ra.

Tháng 9 17, 2012

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)
)

Tháng 9 18, 2012

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

Tháng 9 18, 2012

@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)
)

Tháng 9 18, 2012

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

Tháng 9 18, 2012

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 Tháng 9 18, 2012 theo Skywings

Tháng 9 18, 2012

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 :)

Tháng 9 18, 2012

Ảnh yêu cầu em gửi anh : http://www.mediafire.com/view/?g8krfd5unbe7p7h#

Tháng 9 18, 2012

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

Tháng 9 18, 2012

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

Tháng 9 18, 2012

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é

Tháng 9 18, 2012

à. đú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

Tháng 9 19, 2012

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)
)

Tháng 10 5, 2012

Bác KETXU không giúp em nữa ạ ! hic

Tháng 10 5, 2012

Bác KETXU không giúp em nữa ạ ! hic

Sao từ "anh" mà chuyển sang "bác" nhanh vậy bạn? Phải gọi bằng "anh" thì người ta mới giúp chứ :D

Tháng 10 5, 2012

Vâng. Chắc anh KETXU bận thui. Ít nữa a ý rảnh chắc sẽ giúp em.

Tháng 10 5, 2012

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.

Tháng 11 23, 2012

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

Tháng 11 24, 2012

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

Đăng nhập

[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

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

tien2005 241

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.984

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

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 49

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

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 49

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.984

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

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.984

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

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.984

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

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

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

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

damvinhduy 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

girl 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

aliosa 4

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 16

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 538