[分享]：两点间阵列选择集。

eachy

临时写的，指定两点按间隔复制选择集。

2. [font=courier]
   
3. ($xdrx_load "xdlsp.lsp")
   
4. (defun c:atpoint (/ e ss p1 p2 dis mat cen pts pins)
   
5.   (xdrx_begin)
   
6.   (xdrx_sysvar_push "osmode")
   
7.   (xdrx_ucson)
   
8.   (princ "\n选择阵列实体 .... ")
   
9.   (setq ss (ssget))
   
10.   (if ss
    
11.     (progn
    
12.       (setq p1 (getpoint "\n起点: "))
    
13.       (if p1
    
14.         (progn
    
15.           (xdrx_setsstodb ss 0)
    
16.           (while (and (not pins)
    
17.                       (setq e (xdrx_getentdata 0))
    
18.                  )
    
19.             (if        (= (xdrx_getentdxf 0) "INSERT")
    
20.               (setq pins (xdrx_getentdxf 10))
    
21.             )
    
22.           )
    
23.           (setq p2 (getpoint p1 "\n终点: "))
    
24.           (setq dis (getdist "\n间距: "))
    
25.           (setq        pts ($XDLSP_Points_DividebyIntval
    
26.                       p1
    
27.                       p2
    
28.                       (fix (/ (distance p1 p2) dis))
    
29.                     )
    
30.           )
    
31.           (setq        mat (xdrx_matrix_identity)
    
32.                 cen (xdrx_midp (car (xdrx_entity_box ss))
    
33.                                (caddr (xdrx_entity_box ss))
    
34.                     )
    
35.           )
    
36.           (if pins
    
37.             (setq mat (xdrx_matrix_settranslation mat pins))
    
38.           )
    
39.           (mapcar '(lambda (x)
    
40.                      (xdrx_entity_transformedcopy
    
41.                        ss
    
42.                        (xdrx_matrix_SetTranslation
    
43.                          mat
    
44.                          (mapcar '-
    
45.                                  x
    
46.                                  (if pins
    
47.                                    pins
    
48.                                    cen
    
49.                                  )
    
50.                          )
    
51.                        )
    
52.                      )
    
53.                    )
    
54.                   pts
    
55.           )
    
56.         )
    
57.       )
    
58.     )
    
59.   )
    
60.   (xdrx_ucsoff)
    
61.   (xdrx_sysvar_pop)
    
62.   (xdrx_end)
    
63.   (princ)
    
64. )
    
65. [/font]
    

[font=courier]<br /> ($xdrx_load "xdlsp.lsp")<br /> (defun c:atpoint (/ e ss p1 p2 dis mat cen pts pins)<br />   (xdrx_begin)<br />   (xdrx_sysvar_push "osmode")<br />   (xdrx_ucson)<br />   (princ "\n选择阵列实体 .... ")<br />   (setq ss (ssget))<br />   (if ss<br />     (progn<br />       (setq p1 (getpoint "\n起点: "))<br />       (if p1<br />         (progn<br />           (xdrx_setsstodb ss 0)<br />           (while (and (not pins)<br />                       (setq e (xdrx_getentdata 0))<br />                  )<br />             (if        (= (xdrx_getentdxf 0) "INSERT")<br />               (setq pins (xdrx_getentdxf 10))<br />             )<br />           )<br />           (setq p2 (getpoint p1 "\n终点: "))<br />           (setq dis (getdist "\n间距: "))<br />           (setq        pts ($XDLSP_Points_DividebyIntval<br />                       p1<br />                       p2<br />                       (fix (/ (distance p1 p2) dis))<br />                     )<br />           )<br />           (setq        mat (xdrx_matrix_identity)<br />                 cen (xdrx_midp (car (xdrx_entity_box ss))<br />                                (caddr (xdrx_entity_box ss))<br />                     )<br />           )<br />           (if pins<br />             (setq mat (xdrx_matrix_settranslation mat pins))<br />           )<br />           (mapcar '(lambda (x)<br />                      (xdrx_entity_transformedcopy<br />                        ss<br />                        (xdrx_matrix_SetTranslation<br />                          mat<br />                          (mapcar '-<br />                                  x<br />                                  (if pins<br />                                    pins<br />                                    cen<br />                                  )<br />                          )<br />                        )<br />                      )<br />                    )<br />                   pts<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (xdrx_ucsoff)<br />   (xdrx_sysvar_pop)<br />   (xdrx_end)<br />   (princ)<br /> )<br /> [/font]<br />

lsjjm

按原贴所说"指定两点按间隔复制选择集", 用下列小程序兹不是更简单?
还不用调用那些带xdrx前缀的函数!

2. (defun c:test ()
   
3.   (princ "\nSelect array Objects:")
   
4.   (setq ss (ssget))
   
5.   (setq p1 (getpoint "\nFirst point:"))
   
6.   (setq p2 (getpoint p1 "\nEnd Point:"))
   
7.   (setq  d (getdist "\nDistance:"))
   
8.   (setq nd (1+ (fix (/ (distance p1 p2) d))))
   
9.   (command "ucs" "n" "3" p1 p2 (polar p1 (+ (angle p1 p2)(/ pi 2)) 1) "")
   
10.   (command "array" ss "" "r" 1 nd d)
    
11.   (command "ucs" "w" "")
    
12. (princ)
    
13. )

(defun c:test ()<br />   (princ "\nSelect array Objects:")<br />   (setq ss (ssget))<br />   (setq p1 (getpoint "\nFirst point:"))<br />   (setq p2 (getpoint p1 "\nEnd Point:"))<br />   (setq  d (getdist "\nDistance:"))<br />   (setq nd (1+ (fix (/ (distance p1 p2) d))))<br />   (command "ucs" "n" "3" p1 p2 (polar p1 (+ (angle p1 p2)(/ pi 2)) 1) "")<br />   (command "array" ss "" "r" 1 nd d)<br />   (command "ucs" "w" "")<br /> (princ) <br /> )

eachy

entity_transformedcopy 有 copy 功能，可以是任意位置，不一定在原地阵列。

lsjjm

我的程序也不一定是在原地呀!

eachy

最初由 lsjjm 发布
[B]我的程序也不一定是在原地呀! [/B]

一点点区别。

i_want_2

有什么区别啊，看不出来，我太笨了

eachy

最初由 i_want_2 发布
[B]有什么区别啊，看不出来，我太笨了 [/B]

lsjjm 的是 array ，用api 的严格说是 copy 。

aeo

最初由 eachy 发布
[B]
lsjjm 的是 array ，用api 的严格说是 copy 。 [/B]

array也是copy,看3darray.lsp.
用copy实现也不麻烦.

xgwl

LKPT工具集 for AutoCAD 2002/2004  就包含了~~~

梦断江南

*-*5
贴个以前的

2. 
   
3. ;;ar线性阵列array [1*n]----lxx.2001.2
   
4. ;;动态调整角度，个数
   
5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
6. (defun c:ar (/ ss p1 p2 ang t key n pp)
   
7. (princ "\n ar线性阵列array [1*n]----lxx.2001.2")
   
8. (setvar "cmdecho" 1)(setvar "blipmode" 0)
   
9. (setq ss (ssget))
   
10. (setq p1 (getpoint "\n 总长起点:")
    
11.       P2 (getpoint p1 "\n 总长终点:")
    
12.       ang (angle p1 p2)
    
13.       t "true")
    
14. (command "undo" "m")
    
15. (command "copy" ss "" p1 p2 "")
    
16. (while t
    
17. (setq key (getstring "\n D-按固定间距/T-调总长,角度/<退出>/个数:"))
    
18. (cond
    
19.   ((= "D" (strcase key))(ardist));;;;;;;;;;;;---------ardist
    
20.   ((if (<= 2 (atoi key))(setq n (atoi key)))(arn))
    
21.   ((= "T" (strcase key))
    
22.    (setq p1 (getpoint "\n 总长起点:")
    
23.          P2 (getpoint p1 "\n 总长终点:")
    
24.          ang (angle p1 p2)         
    
25.     )(arn));;;;;;;;;;;;;;;;;;;;------arn
    
26.   ((= "" key)(setq t nil))
    
27. )
    
28. )(princ)
    
29. )
    
30. ;;;;;;;;arn;;;;;;调整个数
    
31. (defun arn ()
    
32. (command "undo" "b" "undo" "m")
    
33. (setq l (/(distance p1 p2)(1- n)) i 1)
    
34. (repeat (1- n)
    
35. (setq pp (polar p1 ang (* i l)) i (1+ i))
    
36. (command "copy" ss "" p1 pp)
    
37. )
    
38. )
    
39. ;;;;;;;;ard;;;;;;;;;按固定间距array
    
40. (defun ardist ()
    
41. (setq d (getdist "\n固定间距:") tt "tt" i 1)
    
42. (command "undo" "b" "undo" "m")
    
43. (while (> (distance p1 p2) (* i d))
    
44. (setq  pp (polar p1 ang (* i d)) i (1+ i))
    
45. (command "copy" ss "" p1 pp)
    
46. )
    
47. )
    
48. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
49. (princ "\n ar线性阵列array [1*n]----lxx.2001.2")(princ)
    

<br /> ;;ar线性阵列array [1*n]----lxx.2001.2<br /> ;;动态调整角度，个数<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun c:ar (/ ss p1 p2 ang t key n pp)<br /> (princ "\n ar线性阵列array [1*n]----lxx.2001.2")<br /> (setvar "cmdecho" 1)(setvar "blipmode" 0)<br /> (setq ss (ssget))<br /> (setq p1 (getpoint "\n 总长起点:") <br />       P2 (getpoint p1 "\n 总长终点:")<br />       ang (angle p1 p2)<br />       t "true")<br /> (command "undo" "m")<br /> (command "copy" ss "" p1 p2 "")<br /> (while t<br /> (setq key (getstring "\n D-按固定间距/T-调总长,角度/<退出>/个数:"))<br /> (cond<br />   ((= "D" (strcase key))(ardist));;;;;;;;;;;;---------ardist<br />   ((if (<= 2 (atoi key))(setq n (atoi key)))(arn))<br />   ((= "T" (strcase key))<br />    (setq p1 (getpoint "\n 总长起点:") <br />          P2 (getpoint p1 "\n 总长终点:")<br />          ang (angle p1 p2)         <br />     )(arn));;;;;;;;;;;;;;;;;;;;------arn<br />   ((= "" key)(setq t nil))<br /> )<br /> )(princ)<br /> )<br /> ;;;;;;;;arn;;;;;;调整个数<br /> (defun arn ()<br /> (command "undo" "b" "undo" "m")<br /> (setq l (/(distance p1 p2)(1- n)) i 1)<br /> (repeat (1- n)<br /> (setq pp (polar p1 ang (* i l)) i (1+ i))<br /> (command "copy" ss "" p1 pp)<br /> )<br /> )<br /> ;;;;;;;;ard;;;;;;;;;按固定间距array<br /> (defun ardist ()<br /> (setq d (getdist "\n固定间距:") tt "tt" i 1)<br /> (command "undo" "b" "undo" "m")<br /> (while (> (distance p1 p2) (* i d))<br /> (setq  pp (polar p1 ang (* i d)) i (1+ i))<br /> (command "copy" ss "" p1 pp)<br /> )<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (princ "\n ar线性阵列array [1*n]----lxx.2001.2")(princ)<br />

梦断江南

示例