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

q3_2006 · 发表于 2014-4-11 15:03:39

本帖最后由 q3_2006 于 2014-4-11 15:05 编辑

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

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

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

品茗新秀 · 发表于 2014-4-11 15:40:06

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

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

q3_2006 · 发表于 2014-4-11 15:44:44

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

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

ymcui · 发表于 2014-4-11 16:01:18

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

很不错的程序,谢谢

Q1241274614 · 发表于 2014-4-11 16:12:52

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

品茗新秀 · 发表于 2014-4-11 16:21:49

本帖最后由品茗新秀于 2014-4-11 16:26 编辑

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

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

如果点选方式用entsel就好了

Q1241274614 · 发表于 2014-4-11 18:04:47

再悬赏呀，q3_2006接着干！

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

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

如果点选方式用entsel就好了

(defun c:tt ( / ang box d e h i j k m p p1 p2 pc ss w)
(setvar "osmode" 0)
(or (setq e (car (entsel "\n选取外框:"))) (exit))
(setq d (getdist "\n间距<输入或量取>:")
i 0
j i
k i
m i
box (ebox e)
p1 (car box)
p2 (cadr box)
ss (ssget "c" p1 p2)
pc (mid p1 p2)
)
(mapcar 'set '(w h) (mapcar '- p2 p1))
(while (and (setq p (getpoint "\n点取复制方向:"))
(setq ang (angle pc p))
)
(cond
((or (> (* 0.25 pi) ang 0 ) (= 0 ang) (> (* 2 pi) ang (* 1.75 pi)))
(vl-cmdf "copy" ss "" pc (polar pc 0 (* (+ w d) (setq i (1+ i))))))
((equal ang (* 0.5 pi) (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc (* 0.5 pi) (* (+ h d) (setq j (1+ j))))))
((equal ang pi (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc pi (* (+ w d) (setq k (1+ k))))))
((equal ang (* 1.5 pi) (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc (* 1.5 pi) (* (+ h d) (setq m (1+ m))))))
(t (exit))
)
)
)
(defun ebox (e / pa pb)
(Vlax-Invoke-Method (Vlax-Ename->Vla-Object e ) 'GetBoundingBox 'pa 'pb )
(setq pa (trans (vlax-safearray->list pa) 0 1)
pb (trans (vlax-safearray->list pb) 0 1)
)
(list pa pb)
)
(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) 
        (setvar "osmode" 0) 
        (or (setq e (car (entsel "\n选取外框:"))) (exit)) 
        (setq d (getdist "\n间距<输入或量取>:") 
                i 0 
                j i 
                k i 
                m i 
                box (ebox e) 
                p1 (car box) 
                p2 (cadr box) 
                ss (ssget "c" p1 p2) 
                pc (mid p1 p2) 
        ) 
        (mapcar 'set '(w h) (mapcar '- p2 p1)) 
        (while (and (setq p (getpoint "\n点取复制方向:")) 
        (setq ang (angle pc p)) 
        ) 
                (cond 
                        ((or (> (* 0.25 pi) ang 0 ) (= 0 ang) (> (* 2 pi) ang (* 1.75 pi))) 
                        (vl-cmdf "copy" ss "" pc (polar pc 0 (* (+ w d) (setq i (1+ i)))))) 
                        ((equal ang (* 0.5 pi) (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc (* 0.5 pi) (* (+ h d) (setq j (1+ j)))))) 
                        ((equal ang pi (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc pi (* (+ w d) (setq k (1+ k)))))) 
                        ((equal ang (* 1.5 pi) (* 0.25 pi)) (vl-cmdf "copy" ss "" pc (polar pc (* 1.5 pi) (* (+ h d) (setq m (1+ m)))))) 
                        (t (exit)) 
                ) 
) 
) 
(defun ebox (e / pa pb) 
         (Vlax-Invoke-Method (Vlax-Ename->Vla-Object e ) 'GetBoundingBox 'pa 'pb ) 
             (setq pa (trans (vlax-safearray->list pa) 0 1) 
                   pb (trans (vlax-safearray->list pb) 0 1) 
             ) 
             (list pa pb) 
) 
(defun mid (p1 p2) (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)))

q3_2006 · 发表于 2014-4-11 18:49:59

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

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

ymcui · 发表于 2014-4-12 08:37:20

太完美了谢谢

账号		自动登录	找回密码
密码			注册

[已解答] 求点选矩形，点上边，向上复制；点右边，向右复制；点下边，向下复制

评分

点评

点评

浏览过的版块