Author Topic: How to make a reactor to enable rxxx commands.  (Read 3197 times)

0 Members and 1 Guest are viewing this topic.

haibinpro

  • Newt
  • Posts: 52
How to make a reactor to enable rxxx commands.
« on: July 21, 2014, 02:33:12 AM »
when type r12,it will make a c:r12 command like this
Code: [Select]
(defun c:r12()
(command "fillet" "r" 12 "")
(command "fillet")
)
when type r102,it will make a c:r102 command like this
Code: [Select]
(defun c:r102()
(command "fillet" "r" 102 "")
(command "fillet")
)

I collect some code may help to do this

code1:
============================================================
Code: [Select]
(or commandReactor
    (setq commandReactor (vlr-command-reactor nil
                    '((:vlr-unknownCommand . Test))
          )
    )
)
(defun Test (a b)
  (if
    (and
      (Setq x (read (car b)))
      (= (type x) 'INT)
      (< -1 x 251)
    )
    (princ (itoa x))
  )
)
cold2:
============================================================
Code: [Select]
;反应器回调函数 用于判断和生成defun函数定义
(defun non_AutoMakeVbaFunc2(a b)
(setq b (car b)
c (non_string_to_list b ".")
d (substr (car c) 2 (- (strlen (car c)) (if (> (length c) 1) 1 2)))
e (substr b 2 (- (strlen b) 2))
f "fillet"
g "r"
h (cadr (non_string_to_list b "."))
h (substr h 1 (1- (strlen h)))
)


(if (or (= "APP" (strcase d))(= "THISDRAWING2" (strcase d))(= "app2" (strcase d))(= "r" (strcase d)))
(eval (read (strcat
"(defun "
d
"()"


"(command "
(vl-princ-to-string (vl-prin1-to-string f))
" "
(vl-princ-to-string (vl-prin1-to-string g))
;"1"
h
")"


"(command "
(vl-princ-to-string (vl-prin1-to-string f))
")"



")"
")"
)))
)
)
;===========================================
;字符串转表
(defun non_string_to_list(str del / lst)
(while (/= str (setq str (vl-string-subst "@" del str))))
(while (setq del (vl-string-position (ascii "@") str))
(setq del (substr str 1 del))
(setq str (vl-string-left-trim (strcat del) str))
(setq lst (append lst (list del)))
(setq str (substr str 2 (strlen str)))
    )
    (append lst (list str))
)

;===========================================
;定义反应器用于判断当前发出的Lisp
(if (not AutoMakeVbaFunc_reactor2)
(setq AutoMakeVbaFunc_reactor2 (vlr-lisp-reactor nil '((:vlr-lispWillStart . non_AutoMakeVbaFunc2))))
)
(princ)


attach is code from nonsmall
« Last Edit: July 21, 2014, 02:36:14 AM by haibinpro »

haibinpro

  • Newt
  • Posts: 52
Re: How to make a reactor to enable rxxx commands.
« Reply #1 on: July 21, 2014, 02:41:48 AM »
 I have a confuse about the code
 (or (= "APP" (strcase d))(= "THISDRAWING2" (strcase d))(= "app2" (strcase d))(= "r" (strcase d)))
 the code below is work when use (app.3) (app.5)etc,but (r.3) (app2.7)is not works.why?
 
Code: [Select]
;反应器回调函数 用于判断和生成defun函数定义
(defun non_AutoMakeVbaFunc2(a b)
(setq b (car b)
c (non_string_to_list b ".")
d (substr (car c) 2 (- (strlen (car c)) (if (> (length c) 1) 1 2)))
e (substr b 2 (- (strlen b) 2))
f "fillet"
g "r"
h (cadr (non_string_to_list b "."))
h (substr h 1 (1- (strlen h)))
)


(if (or (= "APP" (strcase d))(= "THISDRAWING2" (strcase d))(= "app2" (strcase d))(= "r" (strcase d)))
(eval (read (strcat
"(defun "
d
"()"


"(command "
(vl-princ-to-string (vl-prin1-to-string f))
" "
(vl-princ-to-string (vl-prin1-to-string g))
;"1"
h
")"


"(command "
(vl-princ-to-string (vl-prin1-to-string f))
")"



")"
")"
)))
)
)
;===========================================
;字符串转表
(defun non_string_to_list(str del / lst)
(while (/= str (setq str (vl-string-subst "@" del str))))
(while (setq del (vl-string-position (ascii "@") str))
(setq del (substr str 1 del))
(setq str (vl-string-left-trim (strcat del) str))
(setq lst (append lst (list del)))
(setq str (substr str 2 (strlen str)))
    )
    (append lst (list str))
)

;===========================================
;定义反应器用于判断当前发出的Lisp
(if (not AutoMakeVbaFunc_reactor2)
(setq AutoMakeVbaFunc_reactor2 (vlr-lisp-reactor nil '((:vlr-lispWillStart . non_AutoMakeVbaFunc2))))
)
(princ)

Also there is a confuse about the recall function.
the recall function have a para name a.what is a explain for.any information about it is welcome.
(defun Test (a b)
(defun non_AutoMakeVbaFunc(a b)

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: How to make a reactor to enable rxxx commands.
« Reply #2 on: July 21, 2014, 12:32:24 PM »
This seems to work:
Code: [Select]
(if (null fillet:reactor)
    (setq fillet:reactor (vlr-command-reactor nil '((:vlr-unknowncommand . fillet:callback))))
)
(defun fillet:callback ( obj arg / rad )
    (if (and (wcmatch (setq arg (strcase (car arg))) "R#*")
             (setq rad (distof (substr arg 2)))
        )
        (eval
            (vl-list* 'defun (read (strcat "c:" arg)) 'nil (list 'setvar ''filletrad rad)
               '(
                    (vl-cmdf "_.fillet")
                    (while (< 0 (getvar 'cmdactive)) (vl-cmdf "\\"))
                    (princ)
                )
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

haibinpro

  • Newt
  • Posts: 52
Re: How to make a reactor to enable rxxx commands.
« Reply #3 on: July 22, 2014, 03:18:11 AM »
Thanks Mr Lee.
It works sometime,but mostly not works,seems my computer's problem.
I'll try reinstall autocad to fix it.

命令: r2 ; 错误: 出现异常: 0xC0000005 (访问冲突)
; 警告: 忽略展开 异常
; 错误: 出现异常: 0xC0000005 (访问冲突)
未知命令“R2”。按 F1 查看帮助。
命令: R2 ; 错误: ads_undef 失败: <名称 编号 资源>: C:R2 2947 22
未知命令“R2”。按 F1 查看帮助。

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: How to make a reactor to enable rxxx commands.
« Reply #4 on: July 23, 2014, 05:03:42 AM »
I was trying to improve fillet:callback so that it would run the newly created function.
To my surprise only the first piece of code works (insert code before the final princ statement).
Note: I use BricsCAD.
Code: [Select]
(eval (read (strcat "(c:" arg ")")))
Code: [Select]
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) " ")
Code: [Select]
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat arg " "))
Code: [Select]
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "(c:" arg ") "))

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How to make a reactor to enable rxxx commands.
« Reply #5 on: July 23, 2014, 09:03:13 AM »
If you can live with an extra key stroke, this will work without a reactor.
[borrowed a little code from Lee :)]
Code - Auto/Visual Lisp: [Select]
  1. (defun c:mf (/ fr)
  2.   (if (and (setq fr (getstring "\nEnter fillet distance. "))
  3.            fr (not (zerop (atof fr))))
  4.     (progn
  5.       (eval
  6.         (vl-list* 'defun
  7.                   (read (strcat "c:r" fr)) 'nil (list 'setvar ''filletrad (atof fr))
  8.                   '((vl-cmdf "_.fillet")
  9.                     (while (< 0 (getvar 'cmdactive)) (vl-cmdf "\\"))
  10.                     (princ)
  11.                    )
  12.         )
  13.       )
  14.       (princ (strcat "\nCommand R" fr " created"))
  15.     )
  16.     (princ "\nFailed to create a command.")  
  17.   )
  18.   (princ)
  19. )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: How to make a reactor to enable rxxx commands.
« Reply #6 on: July 23, 2014, 05:34:54 PM »
I was trying to improve fillet:callback so that it would run the newly created function.
To my surprise only the first piece of code works (insert code before the final princ statement).

Feel free to modify the code as you see fit!

In my brief tests, the defined function was automatically being evaluated following evaluation of the callback function, as I too initially thought vla-sendcommand would be required within the callback function.

haibinpro

  • Newt
  • Posts: 52
Re: How to make a reactor to enable rxxx commands.
« Reply #7 on: July 23, 2014, 08:34:59 PM »
Code - Auto/Visual Lisp: [Select]
  1. (defun c:mf (/ fr)
  2.   (if (and (setq fr (getstring "\nEnter fillet distance. "))
  3.            fr (not (zerop (atof fr))))
  4.     (progn
  5.       (eval
  6.         (vl-list* 'defun
  7.                   (read (strcat "c:r" fr)) 'nil (list 'setvar ''filletrad (atof fr))
  8.                   '((vl-cmdf "_.fillet")
  9.                     (while (< 0 (getvar 'cmdactive)) (vl-cmdf "\\"))
  10.                     (princ)
  11.                    )
  12.         )
  13.       )
  14.       (princ (strcat "\nCommand R" fr " created"))
  15.     )
  16.     (princ "\nFailed to create a command.")  
  17.   )
  18.   (princ)
  19. )

Works fine.the only problem is this.
command: mf
Enter fillet distance. 5.5

Command R5.5 created

command:
command: r5

command: dra DIMRADIUS

mf a fillet 5.5 command,but it only can use by r5 but not r5.5.the messenger"Command R5.5 created"is not correct.

another thing.

command: mf
Enter fillet distance. dsa
Failed to create a command.

command:
command:  MF
Enter fillet distance. 3r
Command R3r created

command:
command: r3r
command: dra DIMRADIUS

atof Function
 



Converts a string into a real number

(atof string)

Arguments

string

A string to be converted into a real number.

Return Values

A real number.

command: (atof "r3r")
0.0

command: (atof "3")
3.0
« Last Edit: July 23, 2014, 08:38:48 PM by haibinpro »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How to make a reactor to enable rxxx commands.
« Reply #8 on: July 23, 2014, 11:29:13 PM »
Yes decimal points are not allowed in function names. No way around that that I see.

Strings in the radius like 3r can be trapped. And this will do that
Code: [Select]
    (defun c:mf (/ fr)
     (if (and (setq fr (getstring "\nEnter fillet distance. "))
              fr (not (zerop (atof fr)))
              (not (wcmatch fr "*[~0123456789.]*")))
       (progn ........

Back to your fractions, like 5.5
The only way I see to deal with it is to create a routine like this, that starts and waits for the radius.

Enter fc <space> or <enter> then the 5.5 <enter>
Code - Auto/Visual Lisp: [Select]
  1. (defun c:fc (/ fr) ; not sure the FC short cut is being used by ACAD
  2.   (if (and (setq fr (getstring "\nEnter fillet distance. "))
  3.            fr
  4.            (not (zerop (atof fr)))
  5.            (not (wcmatch fr "*[~0123456789.]*"))
  6.       )
  7.     (progn
  8.       (setvar "filletrad" (atof fr))
  9.       (vl-cmdf "_.fillet")
  10.       (while (< 0 (getvar 'cmdactive)) (vl-cmdf "\\"))
  11.       (princ)
  12.     )
  13.     (princ "\nInvalid radius.")
  14.   )
  15.   (princ)
  16. )
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.