如何任意方向指定距离进行连续复制？？？

lpl

如何实现任意方向，能按输入的任意间距数据如400,800,1200,1600,2000........进行连续复制，求高手解决。。。

xiaodao520

楼主应该悬赏，我也需要此代码，帮你顶上。

cable2004

Q1241274614

不错，下载看看！

kwok

弄个简单的
(defun C:tt()
(SETQ ss (SSGET))
(setq p1 (getpoint "\n起点 :"))
(setq p2 (getpoint p1 "\n指定方向:"))
(setq ang (angle p1 p2))
(command "_.COPY" ss "" p1 (setq p1 (polar p1 ang 400)));;400是距离
(command "_.COPY" ss "" p1 (setq p1 (polar p1 ang 800)))
(command "_.COPY" ss "" p1 (setq p1 (polar p1 ang 1200)))
(PRINC)
)

004

1. (defun c:tt (/ ANG DIST I SNAPANG SS)
   
2.   ;;wkq004 2013-01-13
   
3.   (princ "\n选择要复制的实体<退出>-->")
   
4.   (setq ss (ssget))
   
5.   (if ss
   
6.     (progn (if (setq ang (getangle (strcat "\n输入或点取复制角度<"
   
7.                                            (rtos (setq snapang (/ (* 180 (getvar "snapang")) pi)) 2 2)
   
8.                                            ">:"
   
9.                                    )
   
10.                          )
    
11.                )
    
12.              (setvar "snapang" snapang)
    
13.            )
    
14.            (if (setq dist (getdist "\n输入或点取复制距离:"))
    
15.              (progn (princ "\n每次点击复制一次")
    
16.                     (setq i 0)
    
17.                     (while (getpoint) (setq i (1+ i)) (command "array" ss "" "r" 1 2 (* i dist)))
    
18.              )
    
19.            )
    
20.     )
    
21.   )
    
22.   (princ)
    
23. )
    

(defun c:tt (/ ANG DIST I SNAPANG SS)<br />   ;;wkq004 2013-01-13<br />   (princ "\n选择要复制的实体<退出>-->")<br />   (setq ss (ssget))<br />   (if ss<br />     (progn (if (setq ang (getangle (strcat "\n输入或点取复制角度<"<br />                                            (rtos (setq snapang (/ (* 180 (getvar "snapang")) pi)) 2 2)<br />                                            ">:"<br />                                    )<br />                          )<br />                )<br />              (setvar "snapang" snapang)<br />            )<br />            (if (setq dist (getdist "\n输入或点取复制距离:"))<br />              (progn (princ "\n每次点击复制一次")<br />                     (setq i 0)<br />                     (while (getpoint) (setq i (1+ i)) (command "array" ss "" "r" 1 2 (* i dist)))<br />              )<br />            )<br />     )<br />   )<br />   (princ)<br /> )<br />

lpl

004 发表于 2013-1-13 20:15

能否改下，实现像二楼类似能按一次性输入的距离进行偏移呢

lpl

哪位大虾，写个。

x_s_s_1

写了个复制的

2. 
   
3. (defun c:test1 (/ str lt ss pt1 pt2 ang n obj)
   
4.   (setq str (getstring t "\n输入间距|用,或空格分开|,回车结束："))
   
5.   (if (vl-string-search "," str)
   
6.     (setq lst
   
7.     (read
   
8.       (strcat "("
   
9.        (vl-list->string (subst 32 44 (vl-string->list str)))
   
10.        ")"
    
11.       )
    
12.     )
    
13.     )
    
14.     (setq lst (read (strcat "(" str ")")))
    
15.   )
    
16.   (prompt "\n选择需复制图元")
    
17.   (setq ss (ssget))
    
18.   (setq pt1 (getpoint "\n方向起点："))
    
19.   (setq pt2 (getpoint pt1 "\n方向终点："))
    
20.   (setq ang (angle pt1 pt2))
    
21.   (repeat (setq N (sslength ss))
    
22.     (setq obj (vlax-ename->vla-object (ssname SS (1- n))))
    
23.     (mapcar '(lambda (x)
    
24.         (setq obj (vla-copy obj))
    
25.         (vla-move obj
    
26.     (vlax-3D-point pt1)
    
27.     (vlax-3D-point (setq pt1 (polar pt1 ang x)))
    
28.         )
    
29.       )
    
30.      lst
    
31.     )
    
32.     (setq N (1- N))
    
33.   )
    
34.   (princ)
    
35. )

<br /> (defun c:test1 (/ str lt ss pt1 pt2 ang n obj)<br />   (setq str (getstring t "\n输入间距|用,或空格分开|,回车结束："))<br />   (if (vl-string-search "," str)<br />     (setq lst<br />     (read<br />       (strcat "("<br />        (vl-list->string (subst 32 44 (vl-string->list str)))<br />        ")"<br />       )<br />     )<br />     )<br />     (setq lst (read (strcat "(" str ")")))<br />   )<br />   (prompt "\n选择需复制图元")<br />   (setq ss (ssget))<br />   (setq pt1 (getpoint "\n方向起点："))<br />   (setq pt2 (getpoint pt1 "\n方向终点："))<br />   (setq ang (angle pt1 pt2))<br />   (repeat (setq N (sslength ss))<br />     (setq obj (vlax-ename->vla-object (ssname SS (1- n))))<br />     (mapcar '(lambda (x)<br />         (setq obj (vla-copy obj))<br />         (vla-move obj<br />     (vlax-3D-point pt1)<br />     (vlax-3D-point (setq pt1 (polar pt1 ang x)))<br />         )<br />       )<br />      lst<br />     )<br />     (setq N (1- N))<br />   )<br />   (princ)<br /> )

zyhandw

向各位学习了