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

Giúp hoàn thiện lisp tính độ dốc nước thoát

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

Chào các bác!

Em mới tập tành viết lisp được mấy hôm nay. Nền tảng em chưa vững nên còn nhiều lỗi mong các bác thông cảm. Nhờ bác nào giúp em vấn đề này với.

Cái lisp em viết xong chạy thì tạm ổn theo ý tưởng của em rồi. Nhưng kết thúc lệnh kết quả không hiện ở cuối cùng mà là hiện dòng Command:. Mong các bác giúp đỡ.

Lisp của em đây:


(princ "\nslop-Copyright by Duc-Ree")

(princ)

(defun c:slop(/ b1 b11 b2 b3 b4 b5 b6 b7 b8)

(princ "\nCopyright by Duc-Ree")

(princ)

(setq b4 0)

(setq b1 (getpoint "\nPick first point"))

(while (and

(setq b2 (getpoint "\nPick next point "))

(setq b11 (Distance b1 b2))

(setq b4 (+ b4 b11))

(setq b1 b2)

(/= b2 "")))

(setq b3 (getreal "\nNhap do doc %: "))

(setq b5 (* b3 0.01 b4))

(initget 1 "Dau Cuoi") (setq b8 (getkword "\nChon cao do diem Dau/Cuoi: "))

(if (= b8 "Dau")

(progn

(setq b6 (getreal "\nNhap cao do diem dau: "))

(setq b7 (- b6 b5))

(prompt (strcat "\nCao do diem dau: " (rtos b6 2 1)))

(prompt (strcat "\tTong chieu dai: " (rtos b4 2 1)))

(prompt (strcat "\tCao do diem cuoi: " (rtos b7 2 1)))

(princ))

(progn

(setq b6 (getreal "\nNhap cao do diem cuoi: "))

(setq b7 (+ b6 b5))

(prompt (strcat "\nCao do diem cuoi: " (rtos b6 2 1)))

(prompt (strcat "\tTong chieu dai: " (rtos b4 2 1)))

(prompt (strcat "\tCao do diem dau: " (rtos b7 2 1)))

(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

Chào các bác!

Em mới tập tành viết lisp được mấy hôm nay. Nền tảng em chưa vững nên còn nhiều lỗi mong các bác thông cảm. Nhờ bác nào giúp em vấn đề này với.

Cái lisp em viết xong chạy thì tạm ổn theo ý tưởng của em rồi. Nhưng kết thúc lệnh kết quả không hiện ở cuối cùng mà là hiện dòng Command:. Mong các bác giúp đỡ.

Lisp của em đây:

Lý do là không hiểu đoạn màu đỏ. Bạn giải thích rõ hơ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ý do là không hiểu đoạn màu đỏ. Bạn giải thích rõ hơn?

May quá có bác Doan Van Ha giúp rồi. Ý của em là khi chạy xong lệnh, cad cho kết quả như vầy:

Cao do diem cuoi: 1000  Tong chieu dai: 3456.2     Cao do diem dau: 1034.6

Command:

Ý của em muốn chỉ hiện:

Cao do diem cuoi: 1000  Tong chieu dai: 3456.2     Cao do diem dau: 1034.6

Vì đôi khi thanh command bị kéo nhỏ lại lúc đó chỉ thấy kết quả là:

Command:

Cao do diem cuoi: 1000  Tong chieu dai: 3456.2     Cao do diem dau: 1034.6
 
Command:
Cao do diem cuoi: 1000  Tong chieu dai: 3456.2     Cao do diem dau: 1034.6
 
Command:

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

Bao giờ dòng "Command:" cũng nằm dưới cùng. Bạn muốn thể hiện thêm 1 dòng trên nó nữa thì kéo rộng dòng command lên tí nữa, sẽ thấy được 2 dò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

Bao giờ dòng "Command:" cũng nằm dưới cùng. Bạn muốn thể hiện thêm 1 dòng trên nó nữa thì kéo rộng dòng command lên tí nữa, sẽ thấy được 2 dòng?

Em thấy nhiều lisp kết thúc không có command ở cuối mà bác. Ví dụ như cái lisp em tìm được trên cadviet.com nè bác, bác xem giúp em với.


(defun add_mline () (foreach e_record_sub e_record (cond ((= 10 (car e_record_sub)) (setq pt1 (cdr e_record_sub) mline_len 0.0 ) ) ((= 11 (car e_record_sub)) (setq pt2 (cdr e_record_sub) mline_len (+ mline_len (distance pt2 pt1)) pt1 pt2 ) ) ) ) (setq tot_len (+ tot_len mline_len)) (ssdel e_name ss));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defun C:tg (/ tot_len ss e_name e_record e_type) (setq tot_len 0.0) (setq ss (ssget)) (if (null ss) (exit) ) (while (> (sslength ss) 0) (setq e_name (ssname ss 0)) (setq e_record (entget e_name)) (setq e_type (cdr (assoc '0 e_record))) (cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE" ) (command "lengthen" e_name "") (setq tot_len (+ tot_len (getvar "PERIMETER"))) (ssdel e_name ss) ) ((wcmatch e_type "MLINE") (add_mline)) (e_type (ssdel e_name ss)) ) ) (setq tbao (strcat "\nTotal length is: " (rtos tot_len 2 2))) (alert tbao) (prompt tbao) (princ) )

(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:tg (/ tot_len ss e_name e_record e_type)
(princ "\nCADViet.com © 2007")
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(princ)
)
(princ "\ntg - free lisp from www.cadviet.com")
(princ)
(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:tg (/ tot_len ss e_name e_record e_type)
(princ "\nCADViet.com © 2007")
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(princ)
)
(princ "\ntg - free lisp from www.cadviet.com")
(princ)
(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:tg (/ tot_len ss e_name e_record e_type)
(princ "\nCADViet.com © 2007")
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(princ)
)
(princ "\ntg - free lisp from www.cadviet.com")
(princ)
(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:tg (/ tot_len ss e_name e_record e_type)
(princ "\nCADViet.com © 2007")
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(princ)
)
(princ "\ntg - free lisp from www.cadviet.com")
(princ)
(defun add_mline ()
(foreach e_record_sub e_record
(cond ((= 10 (car e_record_sub))
(setq pt1 (cdr e_record_sub)
mline_len 0.0
)
)
((= 11 (car e_record_sub))
(setq pt2 (cdr e_record_sub)
mline_len (+ mline_len (distance pt2 pt1))
pt1 pt2
)
)
)
)
(setq tot_len (+ tot_len mline_len))
(ssdel e_name ss)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:tg (/ tot_len ss e_name e_record e_type)
(princ "\nCADViet.com © 2007")
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit)
)
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(princ)
)
(princ "\ntg - free lisp from www.cadviet.com")
(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

Chẳng hạn, bạn sửa lại như thế này.

http://www.cadviet.com/upfiles/3/67029_abc_1.lsp

Cảm ơn bác, như vầy thì đúng ý kết quả cuối cùng của em, nhưng vẫn chưa hay lắm, khi bấm F2 để xem thì nó hiện cái lệnh  "ERASE", nếu ẩn nó luôn thì ok.

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

Thích đẹp hơn chút nữa thì sửa:

(command "erase" "")

Thành:

(setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0) (command "erase" "") (setvar "cmdecho" cmd)

  • 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

Thích đẹp hơn chút nữa thì sửa:

(command "erase" "")

Thành:

(setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0) (command "erase" "") (setvar "cmdecho" cmd)

Cảm ơn bác. Cuối cùng cũng hoàn thiện xong kết quả em mong muốn.

Chúc bác thành công 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

Thích đẹp hơn chút nữa thì sửa:

(command "erase" "")

Thành:

(setq cmd (getvar "cmdecho")) (setvar "cmdecho" 0) (command "erase" "") (setvar "cmdecho" cmd)

 

Giải pháp rất hay nhưng chỉ cần

(command)

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


×