1/4镜像增强有了，1/4旋转增强怎样写。

李青松

1/4镜像增强有了，1/4旋转增强怎样写。要求以选择对象的中心作为旋转点


(defun c:tt ( / a b e i l p q s )
    (if
        (and
            (setq s (ssget))
            (setq e (car (entsel "\n选择其它对象的中心作为镜像点: ")))
        )
        (progn
            (vla-getboundingbox (vlax-ename->vla-object e) 'a 'b)
            (setq q
                (mapcar
                   '(lambda ( a b ) (/ (+ a b) 2.0))
                    (vlax-safearray->list a)
                    (vlax-safearray->list b)
                )
            )
            (setq p (trans q 0 1))
            (repeat (setq i (sslength s))
                (setq l (list (vlax-ename->vla-object (ssname s (setq i (1- i))))))
                (foreach v '((1 0) (0 1))
                    (foreach o l
                        (setq l (cons (vlax-invoke o 'mirror q (trans (mapcar '+ p v) 1 0)) l))
                    )
                )
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

xyp1964

“1/4旋转”的含义？贴图说明

李青松

xyp1964 发表于 2014-7-1 13:15
“1/4旋转”的含义？贴图说明

已经贴上说明了，在顶上

xyp1964

李青松

代码共享出来吧，大家都可以分享，没必要压在箱底。

提了一个这么有贡献的问题，竟然没有得到结果。悲哀！

菜卷鱼

求选择图形最小对角点

1. (defun sscornerp ( s / a b i m n o )
   
2.     (repeat (setq i (sslength s))
   
3.         (if
   
4.             (and
   
5.                 (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
   
6.                 (vlax-method-applicable-p o 'getboundingbox)
   
7.                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
   
8.             )
   
9.             (setq m (cons (vlax-safearray->list a) m)
   
10.                   n (cons (vlax-safearray->list b) n)
    
11.             )
    
12.         )
    
13.     )
    
14.     (if (and m n)
    
15.         (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    
16.     )
    
17. )

(defun sscornerp ( s / a b i m n o )<br />     (repeat (setq i (sslength s))<br />         (if<br />             (and<br />                 (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))<br />                 (vlax-method-applicable-p o 'getboundingbox)<br />                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))<br />             )<br />             (setq m (cons (vlax-safearray->list a) m)<br />                   n (cons (vlax-safearray->list b) n)<br />             )<br />         )<br />     )<br />     (if (and m n)<br />         (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))<br />     )<br /> )

求选择图形的中心点

1. (defun centerp (ss )
   
2. (mapcar '(lambda (x)(/ x 2))
   
3. (apply '(lambda (e1 e2)(mapcar '+ e1 e2)) (sscornerp ss)) )
   
4. )

(defun centerp (ss )<br /> (mapcar '(lambda (x)(/ x 2))<br /> (apply '(lambda (e1 e2)(mapcar '+ e1 e2)) (sscornerp ss)) )<br /> )

1993063

(Defun C:TT ( / *error*  EntMid cmd ss)
        (Defun *error* (x)(setvar 'cmdecho cmd)(princ))
        (Defun EntMid ( ent /  maxp maxp )
                (setq ent (vlax-ename->vla-object ent))(vla-getboundingbox ent 'minp 'maxp)
                (setq maxp (vlax-safearray->list maxp) minp (vlax-safearray->list minp))
                (Mapcar '(Lambda (x) (* x 0.5)) (Mapcar '+ minp maxp))
        )
        (setq cmd (getvar 'cmdecho))
        (if (setq ss (ssget))
                (progn
                        (if (setq pt (EntMid (car (entsel))))
                                (progn
                                        (setvar 'cmdecho 0)
                                        (Command "array" ss "" "p" pt 4 "" "")
                                        (setvar 'cmdecho cmd)
                                )
                        )
                )
        )
        (princ)
)

ymcui

1993063 发表于 2014-7-4 09:19
(Defun C:TT ( / *error*  EntMid cmd ss)
        (Defun *error* (x)(setvar 'cmdecho cmd)(princ))
   ...

那四角移动又要怎样写!!!

xyp1964

2. ;; 1/4复制
   
3. (defun c:tt ()
   
4.   (princ "\n选择实体: ")
   
5.   (if (and (setq ss (ssget))
   
6.            (setq s1 (car (entsel "\n选择其它对象确定中心点: ")))
   
7.       )
   
8.     (progn
   
9.       (setq p0 (xyp-9pt s1 5)
   
10.             p1 (xyp-9pt ss 5)
    
11.             p2 (xyp-PtMirrorWith2pt p1 p0 (xyp-Pt2Y p0 1))
    
12.             p3 (polar p0 (angle p1 p0) (distance p1 p0))
    
13.             p4 (xyp-PtMirrorWith2pt p1 p0 (xyp-Pt2x p0 1))
    
14.       )
    
15.       (foreach pt (list p2 p3 p4)
    
16.         (xyp-copymove ss p1 pt)
    
17.       )
    
18.     )
    
19.   )
    
20.   (princ)
    
21. )

;; 1/4复制<br /> (defun c:tt ()<br />   (princ "\n选择实体: ")<br />   (if (and (setq ss (ssget))<br />            (setq s1 (car (entsel "\n选择其它对象确定中心点: ")))<br />       )<br />     (progn<br />       (setq p0 (xyp-9pt s1 5)<br />             p1 (xyp-9pt ss 5)<br />             p2 (xyp-PtMirrorWith2pt p1 p0 (xyp-Pt2Y p0 1))<br />             p3 (polar p0 (angle p1 p0) (distance p1 p0))<br />             p4 (xyp-PtMirrorWith2pt p1 p0 (xyp-Pt2x p0 1))<br />       )<br />       (foreach pt (list p2 p3 p4)<br />         (xyp-copymove ss p1 pt)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

ymcui

xyp1964 发表于 2014-7-4 13:12

呵呵,院长出手就知有没有.高