Lisp hay bị lỗi, tự động undo n lần ???

[leejang 5]

Cái lisp bật lớp, tắt lớp và giữ lớp của em hay bị lỗi quá. Khi mình thực hiện lệnh nhìu khi nó tự động undo trở lại một số bước. Làm mất hết những j mình mới làm. Và nhiều lisp của em hay gặp tình trạng này... Nhờ các bác Pro khám bệnh júp em với !!!

CODE

;= Layiso====

(Defun C:3 (/ SS CNT LAY LAYLST VAL)

 

;(init_bonus_error

(list

(list "cmdecho" 0

"expert" 0

)

T ;flag. True means use undo for error clean up.

);list

:s_big:;init_bonus_error

 

(if (not (setq SS (ssget "i")))

(progn

(prompt "\nChon doi tuong thuoc lop muon giu lai: ")

(setq SS (ssget))

)

)

 

(if SS

(progn

 

(setq CNT 0)

 

(while (setq LAY (ssname SS CNT))

(setq LAY (cdr (assoc 8 (entget LAY))))

(if (not (member LAY LAYLST))

(setq LAYLST (cons LAY LAYLST))

)

(setq CNT (1+ CNT))

)

 

(if (member (getvar "CLAYER") LAYLST)

(setq LAY (getvar "CLAYER"))

(setvar "CLAYER" (setq LAY (last LAYLST)))

)

 

(command "_.-LAYER" "_OFF" "*" "_Y")

(foreach VAL LAYLST (command "_ON" VAL))

(command "")

 

(if (= (length LAYLST) 1)

(prompt (strcat "\nLop " (car LAYLST) " duoc giu lai va la lop hien hanh."))

(prompt (strcat "\n" (itoa (length LAYLST)) " Lop duoc giu lai. "

"Lop " LAY " la lop hien hanh."

)

)

)

)

)

 

(restore_old_error)

 

(princ)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Layon;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(Defun C:1 ()

 

;(init_bonus_error

(list

(list "cmdecho" 0)

nil ;flag. True means use undo for error clean up.

);list

:blink:;init_bonus_error

 

(Command "_.-LAYER" "_ON" "*" "")

(prompt "\nTat ca cac lop trong ban ve da duoc mo.")

 

(restore_old_error)

 

(princ)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Layoff;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:2 ()

(layproc "off")

(princ)

)

(defun LAYPROC ( TASK / NOEXIT OPT BLKLST CNT EN PMT ANS LAY NEST BLKLST)

 

 

; --------------------- Error initialization ---------------------

 

;(init_bonus_error

(list

(list "cmdecho" 0

"expert" 0

)

 

nil ;flag. True means use undo for error clean up.

);list

:blink:;init_bonus_error

[q288 166]

Cái lisp bật lớp, tắt lớp và giữ lớp của em hay bị lỗi quá. Khi mình thực hiện lệnh nhìu khi nó tự động undo trở lại một số bước. Làm mất hết những j mình mới làm. Và nhiều lisp của em hay gặp tình trạng này... Nhờ các bác Pro khám bệnh júp em với !!!

 

Lỗi là do hàm (restore_old_error) nhưng bạn lại ko đưa hàm đó lên nên ko biết xử lý ra sao.

Bạn xóa hết các dòng (restore_old_error) thì sẽ ko còn lỗi.

[leejang 5]

Lỗi là do hàm (restore_old_error) nhưng bạn lại ko đưa hàm đó lên nên ko biết xử lý ra sao.

Bạn xóa hết các dòng (restore_old_error) thì sẽ ko còn lỗi.

Em copy thiếu, đây là đủ bộ :

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(Defun C:3 (/ SS CNT LAY LAYLST VAL)

 

;(init_bonus_error

(list

(list "cmdecho" 0

"expert" 0

)

T ;flag. True means use undo for error clean up.

);list

:s_big:;init_bonus_error

 

(if (not (setq SS (ssget "i")))

(progn

(prompt "\nChon doi tuong thuoc lop muon giu lai: ")

(setq SS (ssget))

)

)

 

(if SS

(progn

 

(setq CNT 0)

 

(while (setq LAY (ssname SS CNT))

(setq LAY (cdr (assoc 8 (entget LAY))))

(if (not (member LAY LAYLST))

(setq LAYLST (cons LAY LAYLST))

)

(setq CNT (1+ CNT))

)

 

(if (member (getvar "CLAYER") LAYLST)

(setq LAY (getvar "CLAYER"))

(setvar "CLAYER" (setq LAY (last LAYLST)))

)

 

(command "_.-LAYER" "_OFF" "*" "_Y")

(foreach VAL LAYLST (command "_ON" VAL))

(command "")

 

(if (= (length LAYLST) 1)

(prompt (strcat "\nLop " (car LAYLST) " duoc giu lai va la lop hien hanh."))

(prompt (strcat "\n" (itoa (length LAYLST)) " Lop duoc giu lai. "

"Lop " LAY " la lop hien hanh."

)

)

)

)

)

 

(restore_old_error)

 

(princ)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

;;;;;;;;;;;;

;(Defun C:1 ()

 

;(init_bonus_error

(list

(list "cmdecho" 0)

nil ;flag. True means use undo for error clean up.

);list

:blink:;init_bonus_error

 

(Command "_.-LAYER" "_ON" "*" "")

(prompt "\nTat ca cac lop trong ban ve da duoc mo.")

 

(restore_old_error)

 

(princ)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

;;;;;;;;;;;

;(defun C:2 ()

(layproc "off")

(princ)

)

(defun LAYPROC ( TASK / NOEXIT OPT BLKLST CNT EN PMT ANS LAY NEST BLKLST)

 

 

; --------------------- Error initialization ---------------------

 

;(init_bonus_error

(list

(list "cmdecho" 0

"expert" 0

)

 

nil ;flag. True means use undo for error clean up.

);list

:blink:;init_bonus_error

 

; -------------------- Variable initialization -------------------

 

(setq NOEXIT T)

 

(setq OPT (getcfg (strcat "AppData/AC_Bonus/Lay" TASK))) ; get default option setting

(if (not (or (null OPT) (= OPT ""))) (setq OPT (atoi OPT)))

 

(setq CNT 0) ; cycle counter

 

 

(while NOEXIT

 

(initget "Options Undo")

(if (= TASK "off")

(setq EN (nentsel "\nOptions/Undo/: "))

(setq EN (nentsel "\nOptions/Undo/: "))

)

 

; ------------------------- Set Options --------------------------

 

(While (= EN "Options")

(initget "No Block Entity")

(cond

((= OPT 1)

(setq PMT "\nBlock level nesting/Entity level nesting/: ")

)

((= OPT 2)

(setq PMT "\nBlock level nesting/No nesting/: ")

)

(T

(setq PMT "\nEntity level nesting/No nesting/: ")

)

)

(setq ANS (getkword PMT))

 

(cond

((null ANS)

(if (or (null OPT) (= OPT ""))

(progn

(print ANS)

(setq OPT 3)

(setcfg (strcat "AppData/AC_Bonus/Lay" TASK) "3")

)

)

)

((= ANS "No")

(setq OPT 1)

(setcfg (strcat "AppData/AC_Bonus/Lay" TASK) "1")

)

((= ANS "Entity")

(setq OPT 2)

(setcfg (strcat "AppData/AC_Bonus/Lay" TASK) "2")

)

(T

(setq OPT 3)

(setcfg (strcat "AppData/AC_Bonus/Lay" TASK) "3")

)

)

 

(initget "Options")

(if (= TASK "off")

(setq EN (nentsel "\nOptions/Undo/: "))

(setq EN (nentsel "\nOptions/Undo/: "))

)

)

 

; ------------------------- Find Layer ---------------------------

 

(if (and EN (not (= EN "Undo")))

(progn

 

(setq BLKLST (last EN))

(setq NEST (length BLKLST))

 

(cond

 

; If the entity is not nested or if the option for entity

; level nesting is selected.

 

((or (= OPT 2) (< (length EN) 3))

(setq LAY (entget (car EN)))

)

 

; If no nesting is desired

 

((= OPT 1)

(setq LAY (entget (car (reverse BLKLST))))

)

 

; All other cases (default)

 

(T

(setq BLKLST (reverse BLKLST))

 

(while (and ; strip out xrefs

( > (length BLKLST) 0)

(assoc 1 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car BLKLST))))))

);and

(setq BLKLST (cdr BLKLST))

)

(if ( > (length BLKLST) 0) ; if there is a block present

(setq LAY (entget (car BLKLST))) ; use block layer

(setq LAY (entget (car EN))) ; else use layer of nensel

)

)

)

 

; ------------------------ Process Layer -------------------------

 

(setq LAY (cdr (assoc 8 LAY)))

 

(if (= LAY (getvar "CLAYER"))

(if (= TASK "off")

(progn

(prompt (strcat "\nDoi tuong thuoc lop " LAY " (day la lop hien hanh) ban co muon tat khong? Co/: "))

(setq ANS (strcase (getstring)))

(if (not (or (= ANS "C") (= ANS "CO") (= ANS "c") (= ANS "co")))

(setq LAY nil)

)

)

(progn

(prompt (strcat "\nCannot freeze layer " LAY". It is the CURRENT layer."))

(setq LAY nil)

)

)

(setq ANS nil)

)

 

(if LAY

(if (= TASK "off")

(progn

(if ANS

(command "_.-LAYER" "_OFF" LAY "_Yes" "")

(command "_.-LAYER" "_OFF" LAY "")

)

(prompt (strcat "\nLop " LAY " da duoc tat."))

(setq CNT (1+ CNT))

)

(progn

(command "_.-LAYER" "_FREEZE" LAY "")

(prompt (strcat "\nLayer " LAY " has been frozen."))

(setq CNT (1+ CNT))

)

)

)

)

 

; -------------- Nothing selected or Undo selected ---------------

 

(progn

(if (= EN "Undo")

(if (> CNT 0)

(progn

(command "_.u")

(setq CNT (1- CNT))

)

(prompt "\nEverything has been undone.")

)

(setq NOEXIT nil)

)

)

)

)

 

(restore_old_error)

 

)

 

 

Có Lisp nó có dòng lệnh :

(setq *error* OLDERR) ; Restore old *error* handler

(PRINC)

Liệu có tác dụng làm unde ko ?

[q288 166]

Em copy thiếu, đây là đủ bộ :

 

Sửa rồi như sau:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun C:3 (/ SS CNT LAY LAYLST VAL)
 (list  (list "cmdecho" 0 "expert" 0 )  T) ;flag. True means use undo for error clean up. 
 (if (not (setq SS (ssget "i")))
   (progn
     (prompt "\nChon doi tuong thuoc lop muon giu lai: ")
     (setq SS (ssget))
   )
 )

(if SS
 (progn
   (setq CNT 0)
   (while (setq LAY (ssname SS CNT))
     (setq LAY (cdr (assoc 8 (entget LAY))))
     (if (not (member LAY LAYLST))
(setq LAYLST (cons LAY LAYLST))
     )
     (setq CNT (1+ CNT))
   )

   (if	(member (getvar "CLAYER") LAYLST)
     (setq LAY (getvar "CLAYER"))
     (setvar "CLAYER" (setq LAY (last LAYLST)))
   )

   (command "_.-LAYER" "_OFF" "*" "_Y")
   (foreach VAL LAYLST (command "_ON" VAL))
   (command "")

   (if	(= (length LAYLST) 1)
     (prompt (strcat "\nLop "
	      (car LAYLST)
	      " duoc giu lai va la lop hien hanh."
      )
     )
     (prompt (strcat "\n"
	      (itoa (length LAYLST))
	      " Lop duoc giu lai. "
	      "Lop "
	      LAY
	      " la lop hien hanh."
      )
     )
   )
 )
)

(restore_old_error)

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(Defun C:1 ()

(list  (list "cmdecho" 0)  nil)	;flag. True means use undo for error clean up. 

(Command "_.-LAYER" "_ON" "*" "")
(prompt "\nTat ca cac lop trong ban ve da duoc mo.")

(restore_old_error)

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun C:2 ()
 (layproc "off")
 (princ)
)

(defun LAYPROC (TASK / NOEXIT OPT BLKLST CNT EN PMT ANS LAY NEST BLKLST)
 (list (list "cmdecho" 0 "expert" 0 )  nil);flag. True means use undo for error clean up. 

				; -------------------- Variable initialization -------------------

 (setq NOEXIT T)

 (setq OPT (getcfg (strcat "AppData/AC_Bonus/Lay" TASK)))
				; get default option setting
 (if (not (or (null OPT) (= OPT "")))
   (setq OPT (atoi OPT))
 )

 (setq CNT 0)	; cycle counter

 (while NOEXIT
   (initget "Options Undo")
   (if	(= TASK "off")
     (setq EN (nentsel "\nOptions/Undo/: "))
     (setq EN (nentsel "\nOptions/Undo/: "))
   )

; ------------------------- Set Options --------------------------

   (While (= EN "Options")
     (initget "No Block Entity")
     (cond
((= OPT 1)
 (setq PMT "\nBlock level nesting/Entity level nesting/: ")
)
((= OPT 2)
 (setq PMT "\nBlock level nesting/No nesting/: ")
)
(T
 (setq PMT "\nEntity level nesting/No nesting/: ")
)
     )
     (setq ANS (getkword PMT))

     (cond
((null ANS)
 (if (or (null OPT) (= OPT ""))
   (progn
     (print ANS)
     (setq OPT 3)
     (setcfg (strcat "AppData/AC_Bonus/Lay" TASK) "3")
   )
 )
)
((= ANS "No")
 (setq OPT 1)
 (setcfg (strcat "AppData/AC_Bonus/Lay" TASK) "1")
)
((= ANS "Entity")
 (setq OPT 2)
 (setcfg (strcat "AppData/AC_Bonus/Lay" TASK) "2")
)
(T
 (setq OPT 3)
 (setcfg (strcat "AppData/AC_Bonus/Lay" TASK) "3")
)
     )

     (initget "Options")
     (if (= TASK "off")
(setq EN (nentsel "\nOptions/Undo/: "))
(setq EN (nentsel "\nOptions/Undo/: "))
     )
   )

; ------------------------- Find Layer ---------------------------

   (if	(and EN (not (= EN "Undo")))
     (progn
(setq BLKLST (last EN))
(setq NEST (length BLKLST))
(cond

; If the entity is not nested or if the option for entity
; level nesting is selected.

  ((or (= OPT 2) (< (length EN) 3))
   (setq LAY (entget (car EN)))
  )

				; If no nesting is desired

  ((= OPT 1)
   (setq LAY (entget (car (reverse BLKLST))))
  )

				; All other cases (default)

  (T
   (setq BLKLST (reverse BLKLST))

   (while
     (and			; strip out xrefs
       (> (length BLKLST) 0)
       (assoc 1
	      (tblsearch "BLOCK"
			 (cdr (assoc 2 (entget (car BLKLST))))
	      )
       )
     )				;and
      (setq BLKLST (cdr BLKLST))
   )
   (if (> (length BLKLST) 0)	; if there is a block present
     (setq LAY (entget (car BLKLST))) ; use block layer
     (setq LAY (entget (car EN))) ; else use layer of nensel
   )
  )
)

				; ------------------------ Process Layer -------------------------

(setq LAY (cdr (assoc 8 LAY)))

(if (= LAY (getvar "CLAYER"))
  (if (= TASK "off")
    (progn
      (prompt
	(strcat
	  "\nDoi tuong thuoc lop "
	  LAY
	  " (day la lop hien hanh) ban co muon tat khong? Co/: "
	)
      )
      (setq ANS (strcase (getstring)))
      (if
	(not
	  (or (= ANS "C") (= ANS "CO") (= ANS "c") (= ANS "co"))
	)
	 (setq LAY nil)
      )
    )
    (progn
      (prompt (strcat "\nCannot freeze layer "
		      LAY
		      ". It is the CURRENT layer."
	      )
      )
      (setq LAY nil)
    )
  )
  (setq ANS nil)
)

(if LAY
  (if (= TASK "off")
    (progn
      (if ANS
	(command "_.-LAYER" "_OFF" LAY "_Yes" "")
	(command "_.-LAYER" "_OFF" LAY "")
      )
      (prompt (strcat "\nLop " LAY " da duoc tat."))
      (setq CNT (1+ CNT))
    )
    (progn
      (command "_.-LAYER" "_FREEZE" LAY "")
      (prompt (strcat "\nLayer " LAY " has been frozen."))
      (setq CNT (1+ CNT))
    )
  )
)
     )

; -------------- Nothing selected or Undo selected ---------------

;;;      (progn
;;;	(if (= EN "Undo")
;;;	  (if (> CNT 0)
;;;	    (progn
;;;	      (command "_.u")
;;;	      (setq CNT (1- CNT))
;;;	    )
;;;	    (prompt "\nEverything has been undone.")
;;;	  )
;;;	  (setq NOEXIT nil)
;;;	)
;;;      )
   )
 )

 (restore_old_error)

)