求助：将选择的图元朝选定方向移动指定距离的程序

theisland

经常用到将一些图元（如标注、文字、块等）移动到距离墙或者柱子一定距离，每次都要输入一个较长的数据，很麻烦，可不可以编写这样一个程序，程序使用时：
1.选择图元，输入命令，空格确定
2.程序提示：指定方向，方向通过鼠标指定（如果程序在这一步能将极轴打开更好）
3.已选择的图元在选定的方向上移动设定好的距离，设定的距离为245.6953

依然小小鸟

不错的帖子

llsheng_73

1. (defun c:tt(/ s1 sstoes p1 p2 d);不知道能不能达到你的要求;
   
2.   (defun mymove(ss p p1 / ty q q1 s1);;参照by-xyp1964的xyp-ScaleEntity
   
3.     (setq ty(type ss)i -1
   
4.     q1(vlax-3D-point(trans p1 1 0))
   
5.     q(vlax-3D-point(trans p 1 0)))
   
6.     (cond((= ty 'ENAME)(vla-move(vlax-ename->vla-object ss)q q1))
   
7.    ((= ty 'PICKSET)
   
8.     (setq i -1)
   
9.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
10.      (mymove s1 p p1)))
    
11.    ((= ty 'LIST)(foreach x ss(mymove x p p1))))
    
12.     );defun
    
13.   (defun SstoEs(ss / a en lst)
    
14.     (if ss(progn(setq a -1)
    
15.       (while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))
    
16.     lst);defun
    
17.   (while(null ASSSDs)(progn (prompt "请选择要移动的对象:")(setq ASSSDs(ssget))))
    
18.   (setq s1(SstoEs ASSSDs))
    
19.   ;;;(command"'snap")(command pause);;;
    
20.   (while(null(setq p2(getpoint(setq p1(nth 1(grread 1 2 1))))"指定移动方向"))))
    
21.   (if(null(setq d(getreal"需要移动的距离<245.6953>")))(setq d 245.6953));;如果不需要改变距离，不要这一行，把下边的d换成245.6953就行
    
22.   (mymove s1 p1(polar p1(angle p1 p2) d))
    
23.   (setq ASSSDs nil);;;;不要这句它会在不选择图元运行的情况下一直默认上一次所选择对象
    
24.   (command"'snap" "OFF")
    
25.   (princ)
    
26.   )

(defun c:tt(/ s1 sstoes p1 p2 d);不知道能不能达到你的要求;<br />   (defun mymove(ss p p1 / ty q q1 s1);;参照by-xyp1964的xyp-ScaleEntity<br />     (setq ty(type ss)i -1<br />     q1(vlax-3D-point(trans p1 1 0))<br />     q(vlax-3D-point(trans p 1 0)))<br />     (cond((= ty 'ENAME)(vla-move(vlax-ename->vla-object ss)q q1))<br />    ((= ty 'PICKSET)<br />     (setq i -1)<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />      (mymove s1 p p1)))<br />    ((= ty 'LIST)(foreach x ss(mymove x p p1))))<br />     );defun<br />   (defun SstoEs(ss / a en lst)<br />     (if ss(progn(setq a -1)<br />       (while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))<br />     lst);defun<br />   (while(null ASSSDs)(progn (prompt "请选择要移动的对象:")(setq ASSSDs(ssget))))<br />   (setq s1(SstoEs ASSSDs))<br />   ;;;(command"'snap")(command pause);;;<br />   (while(null(setq p2(getpoint(setq p1(nth 1(grread 1 2 1))))"指定移动方向"))))<br />   (if(null(setq d(getreal"需要移动的距离<245.6953>")))(setq d 245.6953));;如果不需要改变距离，不要这一行，把下边的d换成245.6953就行<br />   (mymove s1 p1(polar p1(angle p1 p2) d))<br />   (setq ASSSDs nil);;;;不要这句它会在不选择图元运行的情况下一直默认上一次所选择对象<br />   (command"'snap" "OFF")<br />   (princ)<br />   )

theisland

llsheng_73 发表于 2013-11-9 01:53

感谢大侠的热心帮助，程序测试了下，貌似只能对第一次选择的图元操作，想移动别的对象不行；还有就是希望方向选择那步能优化一下：不提示选择什么捕捉间距，而是在运行程序时，程序已经判断十字光标所在点为第一点，同时程序提示指定第二点，左键选定第二点，确定，已经选择的对象即被移动

xyp1964

theisland

xyp1964 发表于 2013-11-9 08:53

咋还是有那么多需要自己输入的啊？能不能简单点，最好不要出现对话框

xyp1964

2. (defun c:tt ()
   
3.   (princ "\n选择实体<退出>: ")
   
4.   (while (setq ss (ssget))
   
5.     (setq p1 (xyp-9pt ss 5))
   
6.     (if        (setq p2 (getpoint p1 "\n方向点<退出>: "))
   
7.       (command"copy" ss "" "non" p1 "non" (polar p1 (angle p1 p2) 245.6953))
   
8.     )
   
9.     (princ "\n选择实体<退出>: ")
   
10.   )
    
11.   (princ)
    
12. )

(defun c:tt ()<br />   (princ "\n选择实体<退出>: ")<br />   (while (setq ss (ssget))<br />     (setq p1 (xyp-9pt ss 5))<br />     (if        (setq p2 (getpoint p1 "\n方向点<退出>: "))<br />       (command"copy" ss "" "non" p1 "non" (polar p1 (angle p1 p2) 245.6953))<br />     )<br />     (princ "\n选择实体<退出>: ")<br />   )<br />   (princ)<br /> )

xyp1964

2. (defun c:tt ()
   
3.   (princ "\n选择实体<退出>: ")
   
4.   (while (setq ss (ssget))
   
5.     (setq p1 (getvar 'VIEWCTR))
   
6.     (if        (and (setq p2 (getpoint p1 "\n方向点<退出>: "))
   
7.              (setq p2 (polar p1 (angle p1 p2) 245.6953))
   
8.         )
   
9.       (command "copy" ss "" "non" p1 "non" p2)
   
10.     )
    
11.     (princ "\n选择实体<退出>: ")
    
12.   )
    
13.   (princ)
    
14. )

(defun c:tt ()<br />   (princ "\n选择实体<退出>: ")<br />   (while (setq ss (ssget))<br />     (setq p1 (getvar 'VIEWCTR))<br />     (if        (and (setq p2 (getpoint p1 "\n方向点<退出>: "))<br />              (setq p2 (polar p1 (angle p1 p2) 245.6953))<br />         )<br />       (command "copy" ss "" "non" p1 "non" p2)<br />     )<br />     (princ "\n选择实体<退出>: ")<br />   )<br />   (princ)<br /> )

theisland

xyp1964 发表于 2013-11-9 10:16

太好了！这就是我想要的结果，非常感谢您的帮助！

theisland

奇怪，怎么找不到设为最佳答案的地方

llsheng_73

theisland 发表于 2013-11-9 07:59
感谢大侠的热心帮助，程序测试了下，貌似只能对第一次选择的图元操作，想移动别的对象不行；还有就是希望 ...

你现在的描述与起初的要求前后.....