[转帖]LISP模拟stretch一例

兰州人

http://en.allexperts.com/q/AutoCAD-1029/2008/7/Scale-stretch-behavior.htm

(defun mstrerr (msg)
 (if msg (princ msg))
 (command "_.undo" "_end")
 (if olderr (setq *error* olderr))
 (princ)
)

(defun c:mstr (/ p1 p2 p3 p4 olderr)
  (command "_.undo" "_g")
  (setq olderr *error* *error* mstrerr)
  (setq p1 (getpoint "\nOne corner:  "))
  (initget 32)
  (setq p2 (getcorner p1 "\nOther corner:  "))
  (setq p3 (getpoint "\nStarting point:  "))
  (initget 32)
  (setq p4 (getpoint p3 "\nEnding point:  "))
  (command "_.stretch" "c" p1 p2 "" p3 p4)
  (setq resp (strcase (getstring "\nContinue or eXit?  ")))
  (While (= resp "C")
     (setq p1 (getpoint "\nOne corner:  "))
     (initget 32)
     (setq p2 (getcorner p1 "\nOther corner:  "))
     (command "_.stretch" "c" p1 p2 "" p3 p4)
     (setq resp (strcase (getstring "\nContinue or eXit?  ")))
  )
 (command "_.undo" "_end")
  (princ)
)