Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Nhờ các bác kiểm tra giúp đoạn code này bị lỗi gì vậy!


  • Please log in to reply
21 replies to this topic

#1 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 10 February 2014 - 10:06 AM

Đầu xuân năm mới chúc toàn thể các thành viên trong diễn đàn mạnh khỏe, thành đạt hơn trong cuộc sống cũng như trong công việc và quan trọng là "lượm" được nhiều tiền hơn năm 2013!

Nhờ các bác kiểm tra giúp em đoạn code dưới đây nó bị lỗi gì mà khi vừa thực hiện lệnh nó đã bị thoát ra ở đoạn chọn đối tượng để xóa.

"Command: ce
Select objects to erase:
Command:"

(chức năng upload bị lỗi gì mà em không thấy nên đành copy thế này mong các bác thông cảm)


;; Continuous Erase - Lee Mac

(defun c:ce ( / *error* flg lst mod pt1 pt2 sel )

(defun *error* ( m ) (redraw) (princ))

(princ "\nSelect objects to erase: ")
(while (and (not flg) (= 3 (car (setq pt1 (grread nil 12 2)))))
(if (setq sel (ssget (setq pt1 (cadr pt1))))
(command "_.erase" sel "")
(progn
(princ "\nSpecify opposite corner: ")
(while (= 5 (car (setq pt2 (grread t 13 0))))
(redraw)
(setq pt2 (cadr pt2)
lst (list pt1 (list (car pt2) (cadr pt1)) pt2 (list (car pt1) (cadr pt2)))
mod (if (< (car pt1) (car pt2)) 0 1)
)
(mapcar '(lambda ( a b ) (grdraw a b -1 mod)) (cons (last lst) lst) lst)
)
(if (listp (setq pt2 (cadr pt2)))
(if (setq sel (ssget (if (&amp;lt; (car pt1) (car pt2)) "_WP" "_CP") lst))
(command "_.erase" sel "")
)
(setq flg t)
)
(redraw)
(princ "\nSelect objects to erase: ")
)
)
)
(princ)
)
  • 0

#2 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 10 February 2014 - 11:43 AM

Đầu xuân năm mới chúc toàn thể các thành viên trong diễn đàn mạnh khỏe, thành đạt hơn trong cuộc sống cũng như trong công việc và quan trọng là "lượm" được nhiều tiền hơn năm 2013!

Nhờ các bác kiểm tra giúp em đoạn code dưới đây nó bị lỗi gì mà khi vừa thực hiện lệnh nó đã bị thoát ra ở đoạn chọn đối tượng để xóa.

"Command: ce
Select objects to erase:
Command:"

(chức năng upload bị lỗi gì mà em không thấy nên đành copy thế này mong các bác thông cảm)


;; Continuous Erase - Lee Mac

(defun c:ce ( / *error* flg lst mod pt1 pt2 sel )

(defun *error* ( m ) (redraw) (princ))

(princ "\nSelect objects to erase: ")
(while (and (not flg) (= 3 (car (setq pt1 (grread nil 12 2)))))
(if (setq sel (ssget (setq pt1 (cadr pt1))))
(command "_.erase" sel "")
(progn
(princ "\nSpecify opposite corner: ")
(while (= 5 (car (setq pt2 (grread t 13 0))))
(redraw)
(setq pt2 (cadr pt2)
lst (list pt1 (list (car pt2) (cadr pt1)) pt2 (list (car pt1) (cadr pt2)))
mod (if (&lt; (car pt1) (car pt2)) 0 1)
)
(mapcar '(lambda ( a b ) (grdraw a b -1 mod)) (cons (last lst) lst) lst)
)
(if (listp (setq pt2 (cadr pt2)))
(if (setq sel (ssget (if (&lt; (car pt1) (car pt2)) "_WP" "_CP") lst))
(command "_.erase" sel "")
)
(setq flg t)
)
(redraw)
(princ "\nSelect objects to erase: ")
)
)
)
(princ)
)

Hề hề hề,

 (if (&lt; (car pt1) (car pt2)) 0 1)

Là lỗi này chăng???


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

#3 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 10 February 2014 - 02:32 PM

&nbsp;

Hề hề hề,
 (if (&amp;lt; (car pt1) (car pt2)) 0 1)
Là lỗi này chăng???

&nbsp;

oh, hình như khi em copy lên đây nó tự dưng bị lỗi đó hay sao đấy, nguyên bản của nó là: (if (< (car pt1) (car pt2)) 0 1)
  • 0

#4 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 10 February 2014 - 03:45 PM

&nbsp; &nbsp;

oh, hình như khi em copy lên đây nó tự dưng bị lỗi đó hay sao đấy, nguyên bản của nó là: (if (< (car pt1) (car pt2)) 0 1)

Hề hề hề,

Ối trời ới, bạn nên gửi nguyên cả cái lisp lên, có thể upload file cũng dược chớ kiểu này thì gay vì vẫn còn cái lỗi chỗ ni nữa nè

 (if (&amp;lt; (car pt1) (car pt2)) "_WP" "_CP") lst))


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

#5 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 10 February 2014 - 09:54 PM

oh, bây giờ chức năng upload mới thấy xuất hiện. em gửi lại mong các anh coi giúp với nhé!

;; Continuous Erase - Lee Mac

(defun c:ce ( / *error* flg lst mod pt1 pt2 sel )

(defun *error* ( m ) (redraw) (princ))

(princ "\nSelect objects to erase: ")
(while (and (not flg) (= 3 (car (setq pt1 (grread nil 12 2)))))
(if (setq sel (ssget (setq pt1 (cadr pt1))))
(command "_.erase" sel "")
(progn
(princ "\nSpecify opposite corner: ")
(while (= 5 (car (setq pt2 (grread t 13 0))))
(redraw)
(setq pt2 (cadr pt2)
lst (list pt1 (list (car pt2) (cadr pt1)) pt2 (list (car pt1) (cadr pt2)))
mod (if (< (car pt1) (car pt2)) 0 1)
)
(mapcar '(lambda ( a b ) (grdraw a b -1 mod)) (cons (last lst) lst) lst)
)
(if (listp (setq pt2 (cadr pt2)))
(if (setq sel (ssget (if (< (car pt1) (car pt2)) "_WP" "_CP") lst))
(command "_.erase" sel "")
)
(setq flg t)
)
(redraw)
(princ "\nSelect objects to erase: ")
)
)
)
(princ)
)

  • 0

#6 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 11 February 2014 - 11:28 AM

oh, bây giờ chức năng upload mới thấy xuất hiện. em gửi lại mong các anh coi giúp với nhé!

;; Continuous Erase - Lee Mac

(defun c:ce ( / *error* flg lst mod pt1 pt2 sel )

(defun *error* ( m ) (redraw) (princ))

(princ "\nSelect objects to erase: ")
(while (and (not flg) (= 3 (car (setq pt1 (grread nil 12 2)))))
(if (setq sel (ssget (setq pt1 (cadr pt1))))
(command "_.erase" sel "")
(progn
(princ "\nSpecify opposite corner: ")
(while (= 5 (car (setq pt2 (grread t 13 0))))
(redraw)
(setq pt2 (cadr pt2)
lst (list pt1 (list (car pt2) (cadr pt1)) pt2 (list (car pt1) (cadr pt2)))
mod (if (< (car pt1) (car pt2)) 0 1)
)
(mapcar '(lambda ( a b ) (grdraw a b -1 mod)) (cons (last lst) lst) lst)
)
(if (listp (setq pt2 (cadr pt2)))
(if (setq sel (ssget (if (< (car pt1) (car pt2)) "_WP" "_CP") lst))
(command "_.erase" sel "")
)
(setq flg t)
)
(redraw)
(princ "\nSelect objects to erase: ")
)
)
)
(princ)
)

Hề hề hề,

Ối trời, lisp chạy phe phé, chả vấp váp chi mà sao bạn nói có lỗi hè???

Mình test lisp trên Cad2004 thì thấy nó chạy rất văn minh lịch sự, không vượt đèn đỏ bao giờ.

Bạn hãy kiểm tra lại , nên nhớ rằng sau mỗi đối tượng bị xóa bạn phải chọn đối tượng tiếp theo nếu muốn tiếp tục và nhấn enter nếu không thích xóa nữa., 


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

#7 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 11 February 2014 - 02:02 PM

em cũng dùng cad2004, em cũng không hiểu nữa vì em dùng cả máy cơ quan và máy ở nhà đều bị đoạn

Command: ce

Select objects to erase: (đúng ra đoạn này cho mình chọn đối tượng cần xóa)

Command: (nhưng nó nhẩy luôn ra đoạn này thoát lệnh mà không cho ta chọn cái gì hết!)

em cũng không hiểu tại sao mà cả 2 máy em dùng đều không được.
  • 0

#8 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 11 February 2014 - 02:13 PM

em cũng dùng cad2004, em cũng không hiểu nữa vì em dùng cả máy cơ quan và máy ở nhà đều bị đoạn

Command: ce

Select objects to erase: (đúng ra đoạn này cho mình chọn đối tượng cần xóa)

Command: (nhưng nó nhẩy luôn ra đoạn này thoát lệnh mà không cho ta chọn cái gì hết!)

em cũng không hiểu tại sao mà cả 2 máy em dùng đều không được.

Hề hề hề,

Bạn thử lại xem, không phải nó thoát lệnh đâu mặc dầu trên dòng command đã trả ra command. Chú ý trên màn hình bạn sẽ thấy con trỏ chuyển thành selection box. và khi đó bạn cứ việc chọn các đối tượng theo cách chọn thông thường sẽ thấy các đối tượng này bị xóa đi cho tới khi nào bạn không chọn nữa mà nhấn enter.

Thực ra thì người viết lisp này nên bổ sung tí tẹo nữa cho người dùng đỡ nhầm lẫn khi thao tác. Song có khi đó lại là chủ ý hay của người viết nên mình cũng không sửa gì thêm cả.

Nếu bạn thấy cần thiết mình sẽ hướng dẫn bạn bổ sung sau, nhưng bạn cứ thử dùng như mình nói xem sao nhé.


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

#9 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 11 February 2014 - 02:42 PM

anh bình ơi, đúng ra khi thực hiện lệnh nó sẽ hiện con trỏ chuột có ô vuông để chọn đối tượng nhưng tại máy của em nó vẫn bình chân như vậy không có tác dụng gì cả. Ghi chú: em mở 1 bản vẽ trắng và vẽ linh tinh sau đó gõ CE không co tác dụng để chọn đối tượng gì cả! có 1 lần em xóa dòng bỏ trọn (princ "\nSelect objects to erase: ") tự nhiên lại được, sau đó ghi lại thì lại bị như cũ và xóa lại như trước cũng không được luôn! chán thật không biết tai sao nữa (em đã thử lại cả mấy máy tại cơ quan cũng đều vậy, không rõ nguyên nhân!)
  • 0

#10 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 12 February 2014 - 10:14 AM

anh bình ơi, đúng ra khi thực hiện lệnh nó sẽ hiện con trỏ chuột có ô vuông để chọn đối tượng nhưng tại máy của em nó vẫn bình chân như vậy không có tác dụng gì cả. Ghi chú: em mở 1 bản vẽ trắng và vẽ linh tinh sau đó gõ CE không co tác dụng để chọn đối tượng gì cả! có 1 lần em xóa dòng bỏ trọn (princ "\nSelect objects to erase: ") tự nhiên lại được, sau đó ghi lại thì lại bị như cũ và xóa lại như trước cũng không được luôn! chán thật không biết tai sao nữa (em đã thử lại cả mấy máy tại cơ quan cũng đều vậy, không rõ nguyên nhân!)

Hề hề hề,

Bạn thử sửa code lại nhu sau và thử xem sao nhé.

1/- Ngay bên dưới dòng code 

(if (setq sel (ssget (setq pt1 (cadr pt1))))

Bạn thêm vào :

 (progn

phía trên dòng code:

(command "_.erase" sel "")

2/- Ngay phía dưới dòng code (command "_.erase" sel "") này bạn thêm vào dòng code:

 (princ "\n Specify other object to erase"))

3/- Lưu lại code.

4/- Load lại lisp và chạy thử 

 

Bạn hãy kiểm tra lại biến hệ thống PICKFIRST của CAD. Nếu nó đang ở giá trị 0 hãy chuyển nó về 1 nhé..


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

#11 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 12 February 2014 - 11:22 AM

em sửa như anh nói cũng vẫn vậy, biến hệ thống PICKFIRST của CAD là 1 có sẵn!

(if (setq sel (ssget (setq pt1 (cadr pt1))))

(progn

(command "_.erase" sel "")

(princ "\n Specify other object to erase"))

(progn

(princ "\nSpecify opposite corner: ")

(while (= 5 (car (setq pt2 (grread t 13 0))))

em thử ở Cad2007 thì lại được bình thường, hay tại cad2004 không dùng được anh nhỉ (cad2004 của anh có lẽ có chương trình gì đó hỗ trợ nên dùng được?)

đây là hình ảnh em chụp lại màn hình của em:

116810_untitled_1.jpg


  • 0

#12 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 12 February 2014 - 12:11 PM

Bạn sửa hàm *error* như này rồi chạy lại để đọc lỗi

 

(defun *error* ( m ) (redraw) (princ m))

  • 1

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 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 12 February 2014 - 12:12 PM

oh, hình như cad2007 lúc đầu chạy được nhưng khi dùng lệnh E (ERASE) để xoá xong dùng lại lệnh CE thì lại bị tương tự như cad2004. hay có lẽ do biến nào đó của E (ERASE) đã có và làm vô hiệu hoá code trên không anh nhỉ?


  • 0

#14 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 12 February 2014 - 12:18 PM

cũng vẫn như vậy anh ketxu a!

116810_untitled_2.jpg


  • 0

#15 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 12 February 2014 - 01:55 PM

cũng vẫn như vậy anh ketxu a!

 

Hề hề hề,

Như vậy nhiều khả năng CAD của bạn có vi rus rồi. bạn hãy thử dùng các phần mềm diệt virus diệt virus trên máy của bạn rồi chạy thử lại lisp xem sao.


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

#16 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 12 February 2014 - 02:32 PM

oh, hình như cad2007 lúc đầu chạy được nhưng khi dùng lệnh E (ERASE) để xoá xong dùng lại lệnh CE thì lại bị tương tự như cad2004. hay có lẽ do biến nào đó của E (ERASE) đã có và làm vô hiệu hoá code trên không anh nhỉ?

Mình chưa tìm ra nguyên nhân vì sao cad2004 bị lỗi, nhưng với cad đời cao hơn (VD: 2007), đã có biến hệ thống DYNMODE thì cách khắc phục lỗi là tắt DYNMODE đi. Hoặc không cần tắt nhưng dùng CE từ command, không dùng CE từ screen.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#17 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 13 February 2014 - 06:27 AM

cảm ơn các anh đã rất nhiệt tình! em đã thử cài lại cad và chuyển đi nhiều máy, quét virus, dùng CE tại command cũng vẫn bị tình trạng đó, thật là khó và đau đầu và mất thời gian của các anh nữa chứ!

hay nhờ các anh có thể viết lại code khác với nội dung tương tự là có thể xoá đối tượng bằng cách chọn đối tượng hoặc quét chọn toàn bộ đối tượng là nó tự xoá mà không cần nhấn Enter nữa.


  • 0

#18 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 13 February 2014 - 10:18 AM

Vì không có Cad 2004 nên tôi chỉ test với DYNMODE = 0

 

;; Continuous Erase - Lee Mac
;; Fix - ndtnv (Dynmode <= 0 or nil)
(defun c:ce ( / *error* flg fl2 k lst mod pt1 pt2 sel)
    (defun *error* ( m ) (redraw) (princ))
    (princ "\nSelect objects to erase: ")
    (while (and (not flg) (or (= 3 (setq k (car (setq pt1 (grread nil 12 2))))) (not fl2) ))
        (if (/= 3 k)
            (setq fl2 t)
        (if (setq sel (ssget (setq pt1 (cadr pt1))))
            (command "_.erase" sel "")
            (progn
                (princ "\nSpecify opposite corner: ")
                (while (= 5 (car (setq pt2 (grread t 13 0))))
                    (redraw)
                    (setq pt2 (cadr pt2)
                    lst (list pt1 (list (car pt2) (cadr pt1)) pt2 (list (car pt1) (cadr pt2)))
                    mod (if (< (car pt1) (car pt2)) 0 1)
                    )
                    (mapcar '(lambda ( a b ) (grdraw a b -1 mod)) (cons (last lst) lst) lst)
                )
                (if (listp (setq pt2 (cadr pt2)))
                (if (setq sel (ssget (if (< (car pt1) (car pt2)) "_WP" "_CP") lst))
                (command "_.erase" sel "")
                )
                (setq flg t)
                )
                (redraw)
                (princ "\nSelect objects to erase: ")
            )
        )
    ))
    (princ)
)
 

  • 1

#19 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 13 February 2014 - 10:26 AM

cảm ơn các anh đã rất nhiệt tình! em đã thử cài lại cad và chuyển đi nhiều máy, quét virus, dùng CE tại command cũng vẫn bị tình trạng đó, thật là khó và đau đầu và mất thời gian của các anh nữa chứ!

hay nhờ các anh có thể viết lại code khác với nội dung tương tự là có thể xoá đối tượng bằng cách chọn đối tượng hoặc quét chọn toàn bộ đối tượng là nó tự xoá mà không cần nhấn Enter nữa.

 

Hay không cần lisp nữa mà Dùng CAD với lệnh Multiple -> 

 

Command: MULTIPLE

 

Enter command name to repeat: e -> gõ E (chính là lệnh ERASE của CAD)

 

Command: MULTIPLE
 
Enter command name to repeat: e
ERASE

  • 1

#20 phamthe

phamthe

    biết vẽ polygon

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

Đã gửi 13 February 2014 - 02:05 PM

cảm ơn các bác đã nhiệt tình giúp đỡ bằng mọi cách! cách của bác ndtnv đã hoàn toàn khắc phục được rồi! 1 lần nữa cảm ơn các bác nhé!


  • 0