[编程交流] 带逃逸追踪spo的grread

;http://www.theswamp.org/index.php?topic=27900.msg334947#msg334947
;_GetChar by mp modified to test grread escape traping
(defun aa (track / done data key result);
   ;;  return the character for the key pressed
   
   (while (not done)
       ;;  stay in the loop until the user presses a key
       (vl-catch-all-apply
          '(lambda ( )
               (setq
                   data nil
                   data (grread track 14 1)
               )
           )
       )
       (setq
           key    (car data)
           result (cadr data)
       )
       (cond
           ;;  user pressed <esc>
           ((null data) (princ "\nescape"))
           ;;  user pressed a key
           ((eq 2 key) (setq done t))
           ;;  user hit right mouse button, consider same as enter
           ((eq 25 key)(setq done t result 13))
       )
   )
   (chr result)
)
;http://www.theswamp.org/index.php?topic=27900.msg334940#msg334940
;test by cab modified to test grread escape traping
;originally (grread t 11 0). End up failing either if grread track argument is nil or t
;hit enter to exit
(defun bb (track / input LastPT ent obj )
 (vl-load-com)
 (while ; stay in loop until one of the COND statements return nil
   (progn
     (setq input (vl-catch-all-apply 'grread (list track (+ 1 2  0)))
   (cond
     ((vl-catch-all-error-p input)
  (princ "\nPressed escape ")
  t ; exit
     )
     ((= 5 (car input)) ; pointing device
      (cond
        ((and LastPT (< (distance (cadr input) LastPT) 0.0001))) ; no update if same point
        ((setq ent (nentselp (setq LastPT (cadr input))))
   (setq obj (vlax-ename->vla-object (car ent)))
   (princ (strcat "\nFound a " (vla-get-objectname obj) " at "(vl-princ-to-string (cadr ent))))
)
      )
      t ; stay in loop
     )
     ((= 2 (car input)) ; Keyboard input
      (princ (vl-prin1-to-string input))
      (if (= (cadr input) 13)
          nil ;exit loop
          t) ; stay in loop
      )
     ((= 3 (car input))  ; Selected 3d point
      (if (setq ent (nentselp (cadr input)))
(progn
   (setq obj (vlax-ename->vla-object (car ent)))
   (princ (strcat "\nFound a " (vla-get-objectname obj) " at the point selected: "(vl-princ-to-string (cadr ent))))
   )
)
      t ; stay in loop
      )
     )
    )
   ) ; while
 (princ)
 )

 ((vl-catch-all-error-p input) (princ "\nPressed escape ") t ); exit 

 ((vl-catch-all-error-p input) (princ "\nPressed escape ") nil ) 

 ((vl-catch-all-error-p input) (prompt "\nPressed escape ") )