[LISP函数]：如何让stretch,或copy记住我曾输入的距离值呢？

litss

我在画图时经常遇到很多东西要拉伸同样的距离，但方向不一致。所以一直想要编个lisp来让cad记住我曾经输入的距离值，并设为默认，只需到时敲回车或空格即可完成输入。同时，拉伸的方向还是由鼠标控制。可惜一直实现不了：（
下边是我参考论坛上相关讨论所得的一点想法，却始终得不到好的效果。请大家帮忙改改吧。

(defun c:sss (/ pt1 pt2)
(setq ss (ssget) pt1 (getpoint "base point :"))
(setq pt (cadr (grread 1)))
(command ".stretch" "c" (getpoint) (getpoint) "r" "all" "a" ss "" pt1 (polar pt1 (angle pt1 pt) (getreal)) pause)
(princ)
)

这其中，两个(getpoint)好像是多余的，但又不知道怎么处理才好。直接去掉（"c" (getpoint) (getpoint) "r" "all" "a"）这一串东西又不行。同时，用(polar pt1 (angle pt1 pt) (getreal))好像得不到想要的效果。而且实际stretch的效果好像会出现反向。怎么办呢？

xyp1964

试试下面水平定距拉伸、垂直定距拉伸的程序：
[php]
;|
ST.lsp 拉伸
* C:ST1 ST2
-- XYP@bsedi.com
2004.11.27
|;
;;;加载ST.lsp，运行ST1水平拉伸、ST2垂直拉伸。
(prompt "\n\r      加载定距拉伸程序。")
;;;-------------------------------------------
;;;主程序
(defun C:ST1 (/ p3 p4 p5)
  (CMDLA0)
  (setq NO1 (@ureal 1 "" "\n\t距离 " NO1))
  (command "osnap" "")
  (while (not (setq p4 (getpoint "\n\t窗口起点 : "))))
  (while (not (setq p5 (getcorner p4 "\n\t对角点 : "))))
  (if (> (car p5) (car p4))
    (setq p3 (list (+ (car p4) NO1) (cadr p4)))
    (setq p3 (list (- (car p4) NO1) (cadr p4)))
  )
  (COMMAND "STRETCH" "C" p4 p5 "" P4 P3)
  (CMDLA1)
)
(defun C:ST2 (/ p3 p4 p5)
  (CMDLA0)
  (setq NO1 (@ureal 1 "" "\n\t距离 " NO1))
  (command "osnap" "")
  (while (not (setq p4 (getpoint "\n\t窗口起点 : "))))
  (while (not (setq p5 (getcorner p4 "\n\t对角点 : "))))
  (if (> (cadr p5) (cadr p4))
    (setq p3 (list (car p4) (+ (cadr p4) NO1)))
    (setq p3 (list (car p4) (- (cadr p4) NO1)))
  )
  (COMMAND "STRETCH" "C" p4 p5 "" P4 P3)
  (CMDLA1)
)
;;;-------------------------------------------
;;;通用子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
)
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
)
(defun @ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2))))
    (setq msg (strcat "\n" msg ": ")))
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp inp def)
)
(DEFUN PXYP (TXT1)
  (SETQ        TXT1 (STRCAT "\n\r      程序命令: " TXT1 "      -- xyp@bsedi.com"))
  (PRINC TXT1)
  (Princ)
)

;;;
(pxyp "ST1(水平拉伸)、ST2(垂直拉伸)")
(princ)
;;;-------------------------------------------
;;;END
[/php]

litss

谢谢xyp1964

试用了一下，感觉不错。以框选方向来确定拉伸方向，是个不错的创意，比之stretch少了一步确定方向的操作，自然也快了不少。

不过还是有点遗憾。可能是习惯了stretch，对于框选完的同时也是拉伸完，还是有一点点的不习惯。因为自己经常要“r”或者“a”来修改选择集（操作中很难一次选择好要拉伸的对象）。不知道有没有解决的办法呢？