[求助]：为拉伸，移动，复制之类添加数值记忆功能

zx0sl

请问在cad中，拉伸，移动，复制之类的输入的数值都没有记忆功能，每次都要重新输入，而我又经常干这种事，谁能帮忙写一下

gysjy

你希望记忆选择集呢，还是希望记忆拉伸、移动的距离方向？

zx0sl

多谢gysjy ，你很热心
我是希望记忆拉伸、移动的距离，不需要每次再去输入数值

gysjy

下面的这个程序，在正交方向上按指定的距离移动图元，选择物体后，自屏幕中心会出现一条正交的方向线，用鼠标可以调整此线的方向，初始缺省方向为向上。确定方向后，再输入移动距离，回车，所选图元就会按你所指定的方向和距离移动。并且在下一次操作时可以记住前次操作的方向和距离。

2. 
   
3.   [FONT=courier new]
   
4. (defun MODES (a)
   
5.   (setq MLST '())
   
6.   (repeat (length a)
   
7.     (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
   
8.     (setq a (cdr a))
   
9.   )
   
10. )
    
11. (defun MODER ()
    
12.   (repeat (length MLST)
    
13.     (setvar (caar MLST) (cadar MLST))
    
14.     (setq MLST (cdr MLST))
    
15.   )
    
16. )
    
17. (princ "\n欢迎使用定距移动程序！命令名：md   === gysjy 2008.12===")
    
18. (defun c:md(/ ss p1 p2 ang dis p3)   
    
19.   (modes '("osmode" "cmdecho" "orthomode"))
    
20.   (setvar "osmode" 0)
    
21.   (setvar "cmdecho" 0)
    
22.   (setvar "orthomode" 1)
    
23.   (setq ss (ssget) p1 (getvar "viewctr"))   
    
24.   (if mvang0
    
25.     (foreach n ' ((0 "向右")(1 "向上")(3 "向左")(4 "向下"))
    
26.       (if (= (fix mvang0) (car n)) (setq fx0 (cadr n)))
    
27.     )
    
28.     (setq fx0 "竖直向上")
    
29.   )
    
30.   (setq p2 (getpoint (strcat "\n搬移方向<" fx0 ">:") p1))
    
31.   (if p2 (setq ang (angle p1 p2)) (setq ang (if mvang0 mvang0 (/ pi 2))))
    
32.   (if (= distan nil) (setq distan 1000))
    
33.   (princ  "\n移动距离<") (princ distan)
    
34.   (setq dis (getint  ">:" ))
    
35.   (if (= dis nil) (setq dis distan))
    
36.   (setq p3 (polar p1 ang dis))
    
37.   (command "move"   ss "" p1 p3)
    
38.   (setq distan dis mvang0 ang)
    
39.   (princ "\n(gysjy  2008.12 制作)")  
    
40.   (moder)
    
41.   (princ)
    
42. )
    
43.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun MODES (a)<br />   (setq MLST '())<br />   (repeat (length a)<br />     (setq MLST (append MLST (list (list (car a) (getvar (car a))))))<br />     (setq a (cdr a))<br />   )<br /> )<br /> (defun MODER ()<br />   (repeat (length MLST)<br />     (setvar (caar MLST) (cadar MLST))<br />     (setq MLST (cdr MLST))<br />   )<br /> )<br /> (princ "\n欢迎使用定距移动程序！命令名：md   === gysjy 2008.12===")<br /> (defun c:md(/ ss p1 p2 ang dis p3)    <br />   (modes '("osmode" "cmdecho" "orthomode")) <br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setvar "orthomode" 1)<br />   (setq ss (ssget) p1 (getvar "viewctr"))    <br />   (if mvang0<br />     (foreach n ' ((0 "向右")(1 "向上")(3 "向左")(4 "向下"))<br />       (if (= (fix mvang0) (car n)) (setq fx0 (cadr n)))<br />     )<br />     (setq fx0 "竖直向上")<br />   )<br />   (setq p2 (getpoint (strcat "\n搬移方向<" fx0 ">:") p1))<br />   (if p2 (setq ang (angle p1 p2)) (setq ang (if mvang0 mvang0 (/ pi 2))))<br />   (if (= distan nil) (setq distan 1000))<br />   (princ  "\n移动距离<") (princ distan)<br />   (setq dis (getint  ">:" ))<br />   (if (= dis nil) (setq dis distan)) <br />   (setq p3 (polar p1 ang dis))<br />   (command "move"   ss "" p1 p3)<br />   (setq distan dis mvang0 ang)<br />   (princ "\n(gysjy  2008.12 制作)")  <br />   (moder) <br />   (princ)<br /> )<br />   [/FONT]<br />

gysjy

图示：

zx0sl

多谢gysjy  了，前两天出差了，没来得及看
恩，已经可以达到我的要求了，拉伸复制也都可以用，不过你指定的基点是屏幕中心，我改成指定基点了
另外你可以把程序打包成一个文件吗？下载了你编的几个程序真的很不错

zhongyang730

多谢了，不知好不好用，但看起来不错

hustluo93

这个功能CAD本来就有。不用程序。方法：1.选择对象。2.移动命令。3.制定一个点。4拉开一个方向。5.输入距离。注意：与正常的移动不同的是第5步。正常的移动第5步是指定第二个点。

gysjy

最初由 hustluo93 发布
[B]这个功能CAD本来就有。不用程序。方法：1.选择对象。2.移动命令。3.制定一个点。4拉开一个方向。5.输入距离。注意：与正常的移动不同的是第5步。正常的移动第5步是指定第二个点。 [/B]

有记忆功能吗？

paladi

谢谢楼主，很好用，如果可能不要开始的水平垂直对我来说更方便。

hounengwei

谢谢楼主，很好用，如果可能不要开始的水平垂直对我来说更方便。

gysjy

最初由 paladi 和 hounengwei

发布
[B]谢谢楼主，很好用，如果可能不要开始的水平垂直对我来说更方便。 [/B]

既然不少朋友需要非正交的移动，现将程序修改如下：
[PHP](princ "\n欢迎使用定距移动程序！命令名：md   === gysjy 2009.8===")
(defun c:md(/ ss p1 p2 ang dis p3)   
  (setq os (getvar "osmode") ot (getvar "orthomode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setvar "orthomode" 0)
  (setq ss (ssget) p1 (getpoint "\n基点："))   
  (if mvang0
    (setq fix0 "刚才方向")(setq fix0 "竖直向上")
  )
  (setq p2 (getpoint (strcat "\n搬移方向<" fix0 ">:") p1))
  (if p2 (setq ang (angle p1 p2)) (setq ang (if mvang0 mvang0 (/ pi 2))))
  (if (= distan nil) (setq distan 1000))
  (princ  "\n移动距离<") (princ distan)
  (setq dis (getint  ">:" ))
  (if (= dis nil) (setq dis distan))
  (setq p3 (polar p1 ang dis))
  (command "move"   ss "" p1 p3)
  (setq distan dis mvang0 ang)
  (setvar "osmode" os)
  (setvar "orthomode" ot)
  (princ "\n(gysjy  2009.8 制作)")  
  (moder)
  (princ)
)[/PHP]

paladi

楼主，让我说什么好呢，您真是个热心人，真的很感谢。

yinzhun22

距离能不能在输入数值的基础上，添加用点取两点距离作为后面移动，拉伸的距离，并记录下

paladi

楼主，非正交移动的那个LISP发现一个小地方不是很方便啊，就是一使用这个命令就没有捕捉了，要重新点F3才能再设置捕捉，能否修改成使用的时候仍然保持捕捉啊。