Topic: Problem with acet-sys-control-down inside while loop

[roy_043]

Some acet-* functions have recently been added to BricsCAD and this may be a BricsCAD only issue.

I would like to use the acet-sys-control-down function inside a while loop to allow the user to interrupt a longish process. The function works but not inside a while loop. Am I missing something?

To test: Start the Test function and hold down the left mouse button and the Control key.
Result: Only the mouse button action is detected.

Code: [Select]

(defun c:test ( / i)
  (setq i -1)
  (while (< (setq i (1+ i)) 50000)
    (print i)
    (print (acet-sys-control-down))
    (print (acet-sys-lmouse-down))
  )
  (princ)
)

[TMoses]

Dear Roy,

indeed, the problem was introduced when switching to a WxWidgets based keyboard state function;
but obviously, those functions are not reliable under high CPU load (or maybe need better handling from BricsCAD side).

Now I have fixed by additionally verifying the Windows API functions for keyboard state, and your sample code runs fine; not yet published, but likely in next BricsCAD update.

You should have sent a bug report - then I would have fixed it much earlier
Many thanks & many greetings !

[roy_043]

Thank you very much Torsten!

[ahsattarian]

Have a look at this  :

Code - Auto/Visual Lisp: [Select]

1. (defun c:a ()
2.   (defun sub1 () (redraw) (cond (pl (entdel pl))) (cond (mt (entdel mt))))
3.   (defun sub2 ()
4.     (if (acet-sys-shift-down) ;|  #shift  |;
5.       (if (acet-sys-control-down) ;|  #ctrl  |;
6.         (setq col 135)
7.         (setq col 165)
8.       )
9.       (if (acet-sys-control-down) ;|  #ctrl  |;
10.         (setq col 225)
11.         (setq col 254)
12.       )
13.     )
14.     (if (acet-sys-lmouse-down) ;|  #mouse  |;
15.       (setq col 44)
16.     )
17.     ;;(setq po (osnap pt "end,mid,cen,nod,quad,int,ins,per,tan,nea,qui,app,ext,par")) ;|  Not Working  |;
18.     (setq po (osnap pt "end,mid,cen,nod,quad,int,ins,per,tan,nea")) ;|  Working  -  #osnap  |;
19.     (cond (po (setq pt po) (setq col 65)))
20.     (setq x (car pt))
21.     (setq y (cadr pt))
22.     (setq z (caddr pt))
23.     ;;(setq txt (strcat "\\fArial;\\C250;X=" (vl-princ-to-string x) "\\P" "Y=" (vl-princ-to-string y))) ;|  #arial  |;
24.     (setq txt (strcat "\\fArial;\\C250;X=" (rtos x 2 pc) "\\P" "Y=" (rtos y 2 pc) "\\P" "Z=" (rtos z 2 pc))) ;|  #arial  |;
25.     (setq po (polar (polar pt (* pi 1.5) (* (getvar "viewsize") 0.05)) (* pi 0.0) (* (getvar "viewsize") 0.05)))
26.     (grdraw po pt 2)
27.     (setq hi (* (getvar "viewsize") 0.03))
28.     (setq method1 3)
29.     (cond
30.       ((= method1 1) (command "line" pt po "") (setq pl (entlast)))
31.       ((= method1 2) (setq pl (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 po))))) ;|  #entmake line  |;
32.       ((= method1 3)
33.        (setq po1 (polar pt (angle pt po) (* (distance po pt) 0.3)))
34.        (setq zarib 0.8)
35.        (setq w1 (* (getvar "viewsize") 0.03 zarib))
36.        (setq w2 (* (getvar "viewsize") 0.01 zarib))
37.        (setq w3 (* (getvar "viewsize") 0.02 zarib))
38.        (setq pl
39.               (entmakex
40.                 (list
41.                   (cons 0 "LWPOLYLINE")
42.                   (cons 100 "AcDbEntity")
43.                   (cons 8 (getvar "clayer"))
44.                   (cons 100 "AcDbPolyline")
45.                   (cons 90 3)
46.                   (cons 70 128)
47.                   (cons 38 0)
48.                   (cons 39 0)
49.                   (cons 10 pt)
50.                   (cons 40 0)
51.                   (cons 41 w1)
52.                   (cons 42 0)
53.                   (cons 10 po1)
54.                   (cons 40 w2)
55.                   (cons 41 w3)
56.                   (cons 42 0)
57.                   (cons 10 po)
58.                   (cons 40 0)
59.                   (cons 41 0)
60.                   (cons 42 0)
61.                 )
62.               )
63.        )
64.       )
65.     )
66.     (setq mt
67.            (entmakex
68.              (list
69.                (cons 0 "MTEXT")
70.                (cons 100 "AcDbEntity")
71.                (cons 100 "AcDbMText")
72.                (cons 1 txt)
73.                (cons 10 po)
74.                (cons 40 hi)
75.                (cons 50 (angle '(0.0 0.0 0.0) (getvar 'ucsxdir)))
76.                (cons 62 250)
77.                (cons 71 1)
78.                (cons 72 5)
79.                (cons 90 1)
80.                (cons 63 col)
81.                (cons 45 1.2)
82.                (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
83.              )
84.            )
85.     )
86.     (setq pt0 pt)
87.     (princ (strcat "\r   X=" (rtos x 2 pc) "   Y=" (rtos y 2 pc) "   Z=" (rtos z 2 pc)))
88.   )
89.   (defun *error* (msg) (sub1) (setvar "cursorsize" 100) (princ)) ;|  #error  |;
90.   (command "ucs" "world")
91.   ;;(setq pc (getvar "luprec"))
92.   (setq pc (vlax-invoke (vla-get-activedocument (vlax-get-acad-object)) 'GetVariable "luprec")) ;|  #getvar  |;
93.   (setq mt nil)
94.   (setq pl nil)
95.   (setvar "cursorsize" 1)
96.   (princ "\n  Right-Click  to  Draw  :  \n")
97.   (setq g 1)
98.   (while (= g 1)
99.     (setq gr (grread t 4 4))
100.     (setq code (car gr))
101.     (setq pt (cadr gr))
102.     (sub1)
103.     (cond
104.       ((= code 3) (sub2)) ;|  Click Beshe  |;
105.       ((= code 5) (sub2)) ;|  Bedune Click  |;
106.       ((= code 2) (setq g 0)) ;|  Type Beshe  |;
107.       ((= code 25) (setq pt pt0) (sub2) (setq mt nil) (setq pl nil)) ;|  #mouse #right-click  |;
108.     )
109.   )
110.   (setvar "cursorsize" 100)
111.   (princ)
112. )