;;;----------------StretchRight.lsp-----------------------------------------
;;; Purpose: Restores expected behavior of STRETCH command in ACAD 2006
;;; Author : Herman Mayfarth
;;; Date   : 4/23/2005
;;; Version: 1.1
;;; Permission granted to freely use and redistribute without fee.
;;; Supplied "as is," and without warranty, express or implied.
;;; Acknowledgements: Many thanks to Joe Burke & John Uhden for discovering 
;;; STRETCH command behaves as if PICKAUTO=0 when called from a LISP routine,
;;; unless the value of QAFLAGS is >0, and to Trey Mansour for testing this.
;;;-------------------------------------------------------------------------
(vl-cmdf "undefine" "_stretch")
(defun C:Stretch ( / *error* oldpik oldqaf)
  (defun *error* (msg / )
    (setvar "pickstyle" oldpik)
    (setvar "qaflags" oldqaf)
  )
  (setq oldpik (getvar "pickstyle") oldqaf (getvar "qaflags"))
  (setvar "qaflags" 1)
  (cond ((member oldpik '(1 3));group selection enabled
          (setvar "pickstyle" (1- oldpik));disable object grouping
          (vl-cmdf "_.stretch");invoke native stretch command
          (while (=(logand(getvar "CMDACTIVE")1)1)
                 (command pause));pause until completion
        )
        (1 ;group selection disabled
          (vl-cmdf "_.stretch");invoke native stretch command
          (while (=(logand(getvar "CMDACTIVE")1)1)
                 (command pause));pause until completion
        )
  );cond
  (*error* nil);restore sysvars
  (princ)
);C:Stretch
(princ "\n StretchRight Loaded.")
(princ)