How can I modify the following code with "command-s " ?

How can I modify the following code with "command-s " ?

Anonymous
Not applicable
1,201 Views
8 Replies
Message 1 of 9

How can I modify the following code with "command-s " ?

Anonymous
Not applicable

Hi guys 

 

At CAD2015 ,can't use "command" and "vl-cmdf" in error function 

 

If use command-s , can't write like this:

(command-s "_.undo")
(command-s "_end")

So ,How can I modify the following code with "command-s " ?

 

(while (not (wcmatch (getvar "cmdnames") "*UNDO*"))
	(command "_.undo")
)
(command "_end")
(command* "_.undo" "1")
(while (not (= (getvar "cmdnames") "")) (command))
0 Likes
1,202 Views
8 Replies
Replies (8)
Message 2 of 9

kpblc2000
Advisor
Advisor
What are you doing at error-catch function? Perhaps you can make all you need without command, command-s or vl-cmdf functions.
One of my error-catch function seems like:
[code](defun *error* (msg)
(foreach item sysvar_lst
(setvar (car item) (cdr item))
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(princ (strcat "\n" msg))
(princ))[/code]

Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям! | Do you find the posts helpful? "LIKE" these posts!
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.


Алексей Кулик aka kpblc | Aleksei Kulik aka kpblc Facebook | LinkedIn
autolisp.ru
Техническая поддержка программистов Autodesk в СНГ
Библиотека пользовательских lisp-функций | Custom Lisp-function library

0 Likes
Message 3 of 9

Anonymous
Not applicable
(defun err-set (lst / ss varl untag reset bar)

	(vl-load-com)
	(if (= 1 (logand 1 (getvar "pickfirst")))
		(progn
			(setq ss (ssgetfirst))
			(if (not (apply 'or ss)) (setq ss nil))
		)
	)
	(mapcar 'set '(varl untag reset bar) lst)
	(setq $lt-alive$ (if (not $lt-alive$) 1 (1+ $lt-alive$)))
	(if 
		(and 
			(> $lt-alive$ 1)
			(= "*LTErr*" (last $lt-error$))
		)
		(progn
			(setq *error* fy-err $lt-alive$ 1)
			(err-res)
			(setq $lt-alive$ 1)
		)
	)
	(if (<= $lt-alive$ 0)
		(progn
			(setq $lt-alive$ 0)
			(err-res)
			(setq $lt-alive$ 1)
		)
	)
	(if (= $lt-alive$ 1)
		(progn
			(setq $lt-olderror$ *error*)
			(if 
				(or 
					(not (listp $lt-error$))
					(/= "*LTErr*" (last $lt-error$))
				)
				(setq $lt-error$ (list "*LTErr*"))
			)
			(if 
				(or 
					(= (type (car $lt-error$)) 'list)
					(= "*LTErr*" (car $lt-error$))
				)
				(setq $lt-error$ (cons untag $lt-error$))
				(setq $lt-error$ (cons untag (cdr $lt-error$)))
			)
			(if untag
				(undo-set T)
				(setq $lt-undoctl$ nil)
			)
		)
	)
	(var-set (car lst))
	(if (= $lt-alive$ 1)
		(progn
			(setq *error* fy-err)
			(if reset 
				(setq $lt-error$ (append (reverse (cdr (reverse $lt-error$))) (list reset (last $lt-error$))))
			)
		)
	)
	(if ss (apply 'sssetfirst ss))
);end_defun

(defun err-res() 
	(setq 
		$lt-alive$ (1- $lt-alive$)
		$lt-error$ (cons (car $lt-error$)(reverse (cons (last $lt-error$)(cddr (reverse (cdr $lt-error$))))))
	)
	(if (>= $lt-alive$ 0)
		(var-res)
		(setq $lt-varlist$ nil)
	)
	(if (<= $lt-alive$ 0)
		(progn
			(undo-res)
			(if $lt-olderror$ (setq *error* $lt-olderror$ $lt-olderror$ nil))
		)
	)
	(princ)
)

(defun var-set (lst / lst3 a n b lst2)
	(setq lst3 (car $lt-varlist$) n -2)
	(repeat (/ (length lst) 2)
		(setq a    (strcase (nth (setq n (+ n 2)) lst))
			b    (nth (1+ n) lst)
			lst2 (append lst2 (list (list a (getvar a))))
		)
		(if (and $lt-varlist$ (not (assoc a lst3)))
			(setq lst3 (append lst3 (list (list a (getvar a)))))
		)
		(setvar a b)
	)
	(if $lt-varlist$
		(setq $lt-varlist$ (append (list lst3) (cdr $lt-varlist$) (list lst2)))
		(setq $lt-varlist$ (list lst2))
	)
)


(defun var-res (/ lst)

	(if (<= $lt-alive$ 0)
		(setq lst (car $lt-varlist$) $lt-varlist$ (list lst))
		(setq lst (last $lt-varlist$))
	)
	(mapcar '(lambda (x) (apply 'setvar x)) lst)
	(setq $lt-varlist$ (reverse (cdr (reverse $lt-varlist$))))
)


(defun undo-set (varset / x y z)

	(defun x () (getvar "undoctl"))
	(defun y (i) (= (logand i (x)) i))
	(var-set '("cmdecho" 0))
	(setq z (x))
	(if (or (= (x) 0) (= (x) 16)) (command* "_.undo" "_all"))
	(if (or (not (y 1)) (y 2)) (command* "_.undo" "_control" "_all"))
	(if (y 4) (command* "_.undo" "_auto" "_off"))
	(while (y 8) (command* "_.undo" "_end"))
	(while (not (y 8)) (command* "_.undo" "_begin"))
	(var-res)
	(if (= varset T) (setq $lt-undoctl$ z) z)
)


(defun undo-res (/ x)
	(if $lt-undoctl$
		(progn
			(defun x (i val) (= (logand i val) i))
			(var-set '("cmdecho" 0))
			(while (= 8 (logand 8 (getvar "undoctl"))) (command* "_.undo" "_end"))
			(if (/= $lt-undoctl$ (getvar "undoctl"))
				(progn
					(cond
						((= 0 $lt-undoctl$) (command* "_.undo" "_control" "_none"))
						((x 2 $lt-undoctl$) (command* "_.undo" "_control" "_one")) 
					)
					(if (x 4 $lt-undoctl$) (command* "_.undo" "_auto" "_on"))
				)
			)
			(if (not (x 2 (getvar "undoctl"))) (var-res))
			(setq $lt-undoctl$ nil)
		)
	)
)

(defun fy-err (msg)       

	(if 
		(and 
			(listp $lt-error$) 
			(= "*LTErr*" (last $lt-error$))
		)
		(progn
			(mapcar 'eval (cdr (reverse (cdr $lt-error$))))
			(setq $lt-error$ (list (car $lt-error$) (last $lt-error$)))
		)
	)
	(cond
		((= (type $lt-errormsg$) 'list) (eval $lt-errormsg$))
		((= (type $lt-errormsg$) 'str) (setq msg $lt-errormsg$))
		((not $lt-errormsg$) (setq msg nil))
	)
	(if msg (princ msg))
	(while (not (= (getvar "cmdnames") "")) (command*))
	(if 
		(and 
			(or (= (car $lt-error$) 1) (= (car $lt-error$) T))
			$lt-undoctl$
		)
		(progn
			(var-set '("cmdecho" 0))
			(while (not (wcmatch (getvar "cmdnames") "*UNDO*"))
				(command* "_.undo")
			)
			(command* "_end")
			(command* "_.undo" "1")
			(while (not (= (getvar "cmdnames") "")) (command*))
		)
	)
	(setq $lt-alive$ 1)
	(var-res)
	(setq $lt-alive$ 0)
	(undo-res)
	(if $lt-olderror$
		(setq *error* $lt-olderror$ $lt-olderror$ nil)
	)
	(princ)
);;end_defun
0 Likes
Message 4 of 9

kpblc2000
Advisor
Advisor
I think you can try to use smth like this:
(vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "Type your command here")

Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям! | Do you find the posts helpful? "LIKE" these posts!
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.


Алексей Кулик aka kpblc | Aleksei Kulik aka kpblc Facebook | LinkedIn
autolisp.ru
Техническая поддержка программистов Autodesk в СНГ
Библиотека пользовательских lisp-функций | Custom Lisp-function library

0 Likes
Message 5 of 9

Anonymous
Not applicable

How modify this ?

(while (not (wcmatch (getvar "cmdnames") "*UNDO*"))
	(command "_.undo")
)
(command "_end")
(command* "_.undo" "1")
(while (not (= (getvar "cmdnames") "")) (command))

Right ?

 

 

(while (not (wcmatch (getvar "cmdnames") "*UNDO*"))
	(vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "_.undo ")
)
0 Likes
Message 6 of 9

Anonymous
Not applicable
(while (not (wcmatch (getvar "cmdnames") "*UNDO*"))
	(command "_.undo")
)
(command "_end")
(command "_.undo" "1")
(while (not (= (getvar "cmdnames") "")) (command))

and 

 

 

(if (logand (getvar 'UNDOCTL ) 8) (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))))

It's the same?

0 Likes
Message 7 of 9

kpblc2000
Advisor
Advisor
Try to do this (but i don't understand exactly what do you want to do):
[code](setq adoc (vla-get-activedocument (vlax-get-acad-object)))
;; (while (not (wcmatch (getvar "cmdnames") "*UNDO*")) (command "_.undo")) ; ->
(while (not (wcmatch (getvar "cmdnames") "*UNDO*")) (vla-sendcommand adoc "_.undo"))
;; (command "_end") ; ->
(vla-endundomark adoc)
;; (command* "_.undo" "1") ; ->
(vla-sendcommand adoc "_.undo 1")
;; (while (not (= (getvar "cmdnames") "")) (command)) ; ->
(while (not (= (getvar "cmdnames") "")) (vla-sendcommand adoc "\003"))[/code]

Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям! | Do you find the posts helpful? "LIKE" these posts!
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.


Алексей Кулик aka kpblc | Aleksei Kulik aka kpblc Facebook | LinkedIn
autolisp.ru
Техническая поддержка программистов Autodesk в СНГ
Библиотека пользовательских lisp-функций | Custom Lisp-function library

0 Likes
Message 8 of 9

Anonymous
Not applicable

[quote]but i don't understand exactly what do you want to do?[/quote]

 

I just want don't use "command" and "vl-cmdf" function . can use "command-s" function , or  use vla method.

 

 

[quote]Try to do this [/quote]

 

Sorry . It's fail . 

 

(while (not (wcmatch (getvar "cmdnames") "*UNDO*")) (vla-sendcommand adoc "_.undo"))

When run this , CAD and Vlide will Stopped responding

0 Likes
Message 9 of 9

Anonymous
Not applicable
(if(= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark (vla-get-activedocument(vlax-get-acad-object))))
(command-s "_.undo" "1")
(while (not (= (getvar "cmdnames") "")) (command-s))

 

0 Likes