[编程交流] Grread-osnap

    (defun c:test (/ bname key grr ip lastpt ent)
     (setvar "cmdecho" 0)
     (while
       (not (or (eq "" (setq bname (getstring t "\nBlock to Insert: "))) (tblsearch "BLOCK" bname)))
        (princ "\nBlock not found.")
     )
     (while            ;  exit on ENTER or picked point
       (cond ;;=====================================================
        ((eq 2 (car (setq grr (grread t 7 0)))) ; keyboard input
         (setq key (cadr grr))
         (cond ;;-------------------------------------------
          ((= key 13)      ; ENTER- where done here
           (and ent (entdel ent))
           (princ "\nUser Quit.")
           nil         ; exit loop
          )
          ;;-------------------------------------------
          ((member (chr key) '("H" "h")) ; Word entry  'Help'
                  ;(Display_Help) ; your alert box routine
           t         ; stay in loop
          )
          ((member (chr key) '("I" "i")) ; Insert with OSNAP
           (vl-cmdf "_.move" ent "" "_non" lastpt)
           (while (= (logand (getvar "cmdactive") 1) 1) (command pause))
           nil         ; stay in loop
          )
          ((member (chr key) '("L" "l")) ; Left or CCW
           (vl-cmdf "_.rotate" ent "" "_non" ip 90.0)
           t         ; stay in loop
          )
          ((member (chr key) '("R" "r")) ; Right or CW
           (vl-cmdf "_.rotate" ent "" "_non" ip -90.0)
           t         ; stay in loop
          )
          ((member (chr key) '("B" "b")) ; Basepoint
           (vl-cmdf "_.move" ent "" "_non" (getpoint "\nPick New Basepoint: ") "_non" ip)
           t         ; stay in loop
          )
          ;;-------------------------------------------
          ((princ "\nInvalid Keypress.") (princ (strcat msg str)))
         )            ; end cond
        )
        ;;=====================================================
        ((eq 3 (car grr))      ; point picked, make final star
         (setq ip (cadr grr))
         nil            ; exit
        )
        ;;=====================================================
        ((eq 5 (car grr))      ; point from mouse, update object
         (setq ip (cadr grr))
         (if (null lastpt)      ; first time through
           (progn (setq lastpt ip)
             (vl-cmdf "_.-insert" bname "_S" 1.0 "_R" 0.0 "_non" ip)
             (setq ent (entlast))
           )
         )
         (if (> (distance ip lastpt) 0.00001)
           (vl-cmdf "_.move" ent "" "_non" lastpt "_non" ip)
         )
         (setq lastpt ip)
        )
       )               ; end cond
       ;;=====================================================
     )               ; while
     (redraw)
     (princ)
   )