Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
19 replies to this topic

#1 girl

girl

    biết vẽ spline

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

Đã gửi 17 September 2012 - 02:08 PM

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 !
  • 0

#2 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 17 September 2012 - 03:03 PM

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.
  • 0

#3 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 September 2012 - 04:39 PM

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

  • 2

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


#4 girl

girl

    biết vẽ spline

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

Đã gửi 18 September 2012 - 09:05 AM

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
  • 0

#5 Skywings

Skywings

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 46 (tàm tạm)

Đã gửi 18 September 2012 - 09:51 AM

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

  • 0

#6 girl

girl

    biết vẽ spline

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

Đã gửi 18 September 2012 - 09:56 AM

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
  • 0

#7 Skywings

Skywings

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 46 (tàm tạm)

Đã gửi 18 September 2012 - 09:59 AM

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

Bài viết đã được chỉnh sửa nội dung bởi Skywings: 18 September 2012 - 10:25 AM

  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 September 2012 - 10:36 AM

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


#9 girl

girl

    biết vẽ spline

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

Đã gửi 18 September 2012 - 10:47 AM

Ảnh yêu cầu em gửi anh : http://www.mediafire...8krfd5unbe7p7h#
  • 0

#10 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 September 2012 - 10:56 AM

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


#11 girl

girl

    biết vẽ spline

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

Đã gửi 18 September 2012 - 11:43 AM

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
  • 0

#12 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 September 2012 - 11:46 AM

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é
  • 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


#13 girl

girl

    biết vẽ spline

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

Đã gửi 18 September 2012 - 11:48 AM

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

#14 girl

girl

    biết vẽ spline

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

Đã gửi 19 September 2012 - 01:02 PM

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


  • 0

#15 girl

girl

    biết vẽ spline

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

Đã gửi 05 October 2012 - 09:30 AM

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

#16 damvinhduy

damvinhduy

    biết vẽ line

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

Đã gửi 05 October 2012 - 10:33 AM

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
  • 0

#17 girl

girl

    biết vẽ spline

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

Đã gửi 05 October 2012 - 01:48 PM

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

#18 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 05 October 2012 - 10:47 PM

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.
  • 0

#19 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 23 November 2012 - 09:03 PM

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
  • 0

#20 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 24 November 2012 - 10:33 AM

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
  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson