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

q3_2006

来个好理解的版本....

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)
    
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.                 pc (mid p1 p2)
    
20.         )
    
21.         (mapcar 'set '(w h) (mapcar '- p2 p1))
    
22.         (cond
    
23.                 ((and (> (car p) (car pc)) (equal (cadr p) (cadr pc))) (vl-cmdf "-array" e "" "r" 1 n (+ d w)))
    
24.                 ((and (< (car p) (car pc)) (equal (cadr p) (cadr pc))) (vl-cmdf "-array" e "" "r" 1 n (* -1 (+ d w))))
    
25.                 ((and (equal (car p) (car pc)) (> (cadr p) (cadr pc))) (vl-cmdf "-array" e "" "r" n 1 (+ d h)))
    
26.                 (t (vl-cmdf "-array" e "" "r" n 1 (* -1 (+ d h))))
    
27.         )
    
28. )
    
29. )

(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)<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 />                 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" e "" "r" 1 n (+ d w)))<br />                 ((and (< (car p) (car pc)) (equal (cadr p) (cadr pc))) (vl-cmdf "-array" e "" "r" 1 n (* -1 (+ d w))))<br />                 ((and (equal (car p) (car pc)) (> (cadr p) (cadr pc))) (vl-cmdf "-array" e "" "r" n 1 (+ d h)))<br />                 (t (vl-cmdf "-array" e "" "r" n 1 (* -1 (+ d h))))<br />         )<br /> )<br /> )

品茗新秀

q3_2006 发表于 2014-4-11 15:03
来个好理解的版本....

确实不错，如果矩形内有图元，也能一起复制就好了

q3_2006

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

当然可以...问题是你没要求呀....

ymcui

q3_2006 发表于 2014-4-11 15:03
来个好理解的版本....

很不错的程序,谢谢

Q1241274614

q3_2006 写的不错，应该支付了。

品茗新秀

q3_2006 发表于 2014-4-11 15:03
来个好理解的版本....

如果个数采用右键一次，增加一个的方式，就更理想了。

如果点选方式用entsel就好了

Q1241274614

再悬赏呀，q3_2006接着干！

q3_2006

品茗新秀 发表于 2014-4-11 16:21
如果个数采用右键一次，增加一个的方式，就更理想了。

如果点选方式用entsel就好了

2. (defun c:tt ( / ang box d e h i j k m p p1 p2 pc ss w)
   
3.         (setvar "osmode" 0)
   
4.         (or (setq e (car (entsel "\n选取外框:"))) (exit))
   
5.         (setq d (getdist "\n间距<输入或量取>:")
   
6.                 i 0
   
7.                 j i
   
8.                 k i
   
9.                 m i
   
10.                 box (ebox e)
    
11.                 p1 (car box)
    
12.                 p2 (cadr box)
    
13.                 ss (ssget "c" p1 p2)
    
14.                 pc (mid p1 p2)
    
15.         )
    
16.         (mapcar 'set '(w h) (mapcar '- p2 p1))
    
17.         (while (and (setq p (getpoint "\n点取复制方向:"))
    
18.         (setq ang (angle pc p))
    
19.         )
    
20.                 (cond
    
21.                         ((or (> (* 0.25 pi) ang 0 ) (= 0 ang) (> (* 2 pi) ang (* 1.75 pi)))
    
22.                         (vl-cmdf "copy" ss "" pc (polar pc 0 (* (+ w d) (setq i (1+ i))))))
    
23.                         ((equal ang (* 0.5 pi) (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc (* 0.5 pi) (* (+ h d) (setq j (1+ j))))))
    
24.                         ((equal ang pi (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc pi (* (+ w d) (setq k (1+ k))))))
    
25.                         ((equal ang (* 1.5 pi) (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc (* 1.5 pi) (* (+ h d) (setq m (1+ m))))))
    
26.                         (t (exit))
    
27.                 )
    
28. )
    
29. )
    
30. (defun ebox (e / pa pb)
    
31.          (Vlax-Invoke-Method (Vlax-Ename->Vla-Object e ) 'GetBoundingBox 'pa 'pb )
    
32.              (setq pa (trans (vlax-safearray->list pa) 0 1)
    
33.                    pb (trans (vlax-safearray->list pb) 0 1)
    
34.              )
    
35.              (list pa pb)
    
36. )
    
37. (defun mid (p1 p2) (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)))

(defun c:tt ( / ang box d e h i j k m p p1 p2 pc ss w)<br />         (setvar "osmode" 0)<br />         (or (setq e (car (entsel "\n选取外框:"))) (exit))<br />         (setq d (getdist "\n间距<输入或量取>:")<br />                 i 0<br />                 j i<br />                 k i<br />                 m i<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 />         (while (and (setq p (getpoint "\n点取复制方向:"))<br />         (setq ang (angle pc p))<br />         )<br />                 (cond<br />                         ((or (> (* 0.25 pi) ang 0 ) (= 0 ang) (> (* 2 pi) ang (* 1.75 pi))) <br />                         (vl-cmdf "copy" ss "" pc (polar pc 0 (* (+ w d) (setq i (1+ i))))))<br />                         ((equal ang (* 0.5 pi) (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc (* 0.5 pi) (* (+ h d) (setq j (1+ j))))))<br />                         ((equal ang pi (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc pi (* (+ w d) (setq k (1+ k))))))<br />                         ((equal ang (* 1.5 pi) (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc (* 1.5 pi) (* (+ h d) (setq m (1+ m))))))<br />                         (t (exit))<br />                 )<br /> )<br /> )<br /> (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)))

q3_2006

q3_2006 发表于 2014-4-11 18:29

那就不能四方向增加了.....我现在可以四个方向复制....

ymcui

太完美了谢谢