求点选矩形，点上边，向上复制；点右边，向右复制；点下边，向下复制

品茗新秀

求点选矩形，点上边，向上复制；点右边，向右复制；点下边，向下复制；复制距离，用户输入；复制个数，用户输入。

q3_2006

品茗新秀 发表于 2014-4-11 15:40
确实不错，如果矩形内有图元，也能一起复制就好了

2. (defun ebox (e / pa pb)
   
3.          (Vlax-Invoke-Method (Vlax-Ename->Vla-Object e ) 'GetBoundingBox 'pa 'pb )
   
4.              (setq pa (trans (vlax-safearray->list pa) 0 1)
   
5.                    pb (trans (vlax-safearray->list pb) 0 1)
   
6.              )
   
7.              (list pa pb)
   
8. )
   
9. (defun mid (p1 p2) (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)))
   
10. (defun c:tt ( / box d e h n p p1 p2 pc w ss)
    
11.         (setvar "osmode" 2)
    
12.         (while (setq p (getpoint "\n以点取边为阵列方向:"))
    
13.                 (setq e (ssname (ssget "c" p p '((0 . "LWPOLYLINE"))) 0)
    
14.                 n (getint "\n数量:")
    
15.                 d (getdist "\n间距:")
    
16.                 box (ebox e)
    
17.                 p1 (car box)
    
18.                 p2 (cadr box)
    
19.                 ss (ssget "c" p1 p2)
    
20.                 pc (mid p1 p2)
    
21.         )
    
22.         (mapcar 'set '(w h) (mapcar '- p2 p1))
    
23.         (cond
    
24.                 ((and (> (car p) (car pc)) (equal (cadr p) (cadr pc))) (vl-cmdf "-array" ss "" "r" 1 n (+ d w)))
    
25.                 ((and (< (car p) (car pc)) (equal (cadr p) (cadr pc))) (vl-cmdf "-array" ss "" "r" 1 n (* -1 (+ d w))))
    
26.                 ((and (equal (car p) (car pc)) (> (cadr p) (cadr pc))) (vl-cmdf "-array" ss "" "r" n 1 (+ d h)))
    
27.                 (t (vl-cmdf "-array" ss "" "r" n 1 (* -1 (+ d h))))
    
28.         )
    
29. )
    
30. )

(defun ebox (e / pa pb)<br />          (Vlax-Invoke-Method (Vlax-Ename->Vla-Object e ) 'GetBoundingBox 'pa 'pb )<br />              (setq pa (trans (vlax-safearray->list pa) 0 1)<br />                    pb (trans (vlax-safearray->list pb) 0 1)<br />              )<br />              (list pa pb)<br /> )<br /> (defun mid (p1 p2) (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)))<br /> (defun c:tt ( / box d e h n p p1 p2 pc w ss)<br />         (setvar "osmode" 2)<br />         (while (setq p (getpoint "\n以点取边为阵列方向:"))<br />                 (setq e (ssname (ssget "c" p p '((0 . "LWPOLYLINE"))) 0)<br />                 n (getint "\n数量:")<br />                 d (getdist "\n间距:")<br />                 box (ebox e)<br />                 p1 (car box)<br />                 p2 (cadr box)<br />                 ss (ssget "c" p1 p2)<br />                 pc (mid p1 p2)<br />         )<br />         (mapcar 'set '(w h) (mapcar '- p2 p1))<br />         (cond <br />                 ((and (> (car p) (car pc)) (equal (cadr p) (cadr pc))) (vl-cmdf "-array" ss "" "r" 1 n (+ d w)))<br />                 ((and (< (car p) (car pc)) (equal (cadr p) (cadr pc))) (vl-cmdf "-array" ss "" "r" 1 n (* -1 (+ d w))))<br />                 ((and (equal (car p) (car pc)) (> (cadr p) (cadr pc))) (vl-cmdf "-array" ss "" "r" n 1 (+ d h)))<br />                 (t (vl-cmdf "-array" ss "" "r" n 1 (* -1 (+ d h))))<br />         )<br /> )<br /> )

lsjj

懸賞100個，好誘人
可是看過你的帖，從來就沒有給足過

firstinti

cad基本命令搞明白了么

flytoday

套哥………你要用人民币求……你那么牛B

Q1241274614

这么简单？

品茗新秀

Q1241274614 发表于 2014-4-11 12:19
这么简单？

对我们初学者不简单，想了半天，终于完成了一点点，得出中心点，与点取点比较，就会知道复制的方向，但如果想一次多复制几个，这个自我感觉还是有点难

顶出高手，非常想跟在后面好好学习一下

Gu_xl

去研究下array命令先！

xyp1964

2. 
   
3. ;; 需要e派工具箱(XCAD)的支持：[url]http://yunpan.cn/QXQKsW9gAPmpF[/url]
   
4. ;; 另类阵列 2014-04-11
   
5. (defun c:tt ()
   
6.   (xyp-CMDLA0)
   
7.   (xyp-initSet '(dist int) '(1100. 5))
   
8.   (setq dist (UREAL 7 "" "间距" dist))
   
9.   (setq int (Uint 7 "" "数量" int))
   
10.   (while (and (setq e1 (entsel "\n选择: "))
    
11.               (setq s1 (car e1))
    
12.               (xyp-etype s1 "lwpolyline")
    
13.               (= (xyp-DXF 90 s1) 4)
    
14.               (= (xyp-DXF 70 s1) 1)
    
15.          )
    
16.     (setq p0 (osnap (cadr e1) "near")
    
17.           p1 (xyp-9pt s1 1)
    
18.           p3 (xyp-9pt s1 3)
    
19.           p7 (xyp-9pt s1 7)
    
20.           p9 (xyp-9pt s1 9)
    
21.     )
    
22.     (cond ((xyp-3PointAtLine p1 p0 p3) (xyp-ArrayRV s1 int (- dist)))
    
23.           ((xyp-3PointAtLine p7 p0 p9) (xyp-ArrayRV s1 int dist))
    
24.           ((xyp-3PointAtLine p1 p0 p7) (xyp-ArrayRH s1 int (- dist)))
    
25.           ((xyp-3PointAtLine p3 p0 p9) (xyp-ArrayRH s1 int dist))
    
26.     )
    
27.   )
    
28.   (xyp-CMDLA1)
    
29. )
    

<br /> ;; 需要e派工具箱(XCAD)的支持：[url]http://yunpan.cn/QXQKsW9gAPmpF[/url]<br /> ;; 另类阵列 2014-04-11<br /> (defun c:tt ()<br />   (xyp-CMDLA0)<br />   (xyp-initSet '(dist int) '(1100. 5))<br />   (setq dist (UREAL 7 "" "间距" dist))<br />   (setq int (Uint 7 "" "数量" int))<br />   (while (and (setq e1 (entsel "\n选择: "))<br />               (setq s1 (car e1))<br />               (xyp-etype s1 "lwpolyline")<br />               (= (xyp-DXF 90 s1) 4)<br />               (= (xyp-DXF 70 s1) 1)<br />          )<br />     (setq p0 (osnap (cadr e1) "near")<br />           p1 (xyp-9pt s1 1)<br />           p3 (xyp-9pt s1 3)<br />           p7 (xyp-9pt s1 7)<br />           p9 (xyp-9pt s1 9)<br />     )<br />     (cond ((xyp-3PointAtLine p1 p0 p3) (xyp-ArrayRV s1 int (- dist)))<br />           ((xyp-3PointAtLine p7 p0 p9) (xyp-ArrayRV s1 int dist))<br />           ((xyp-3PointAtLine p1 p0 p7) (xyp-ArrayRH s1 int (- dist)))<br />           ((xyp-3PointAtLine p3 p0 p9) (xyp-ArrayRH s1 int dist))<br />     )<br />   )<br />   (xyp-CMDLA1)<br /> )<br />

品茗新秀

xyp1964 发表于 2014-4-11 13:30

演示的意思就是这个意思，可是太高深了，对初学者没办法学习