李青松 发表于 2014-7-1 10:42:24

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

本帖最后由 李青松 于 2014-7-1 13:33 编辑

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 发表于 2014-7-1 13:15:53

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

李青松 发表于 2014-7-1 13:35:01

本帖最后由 李青松 于 2014-7-1 13:36 编辑

xyp1964 发表于 2014-7-1 13:15 static/image/common/back.gif
“1/4旋转”的含义？贴图说明
已经贴上说明了，在顶上

xyp1964 发表于 2014-7-1 13:49:19


李青松 发表于 2014-7-1 14:30:05

本帖最后由 李青松 于 2014-7-1 16:08 编辑

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

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

菜卷鱼 发表于 2014-7-4 08:29:01

求选择图形最小对角点
(defun sscornerp ( s / a b i m n o )
    (repeat (setq i (sslength s))
      (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
      )
    )
    (if (and m n)
      (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)

求选择图形的中心点
(defun centerp (ss )
(mapcar '(lambda (x)(/ x 2))
(apply '(lambda (e1 e2)(mapcar '+ e1 e2)) (sscornerp ss)) )
)

1993063 发表于 2014-7-4 09:19:20

(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 发表于 2014-7-4 10:44:59

本帖最后由 ymcui 于 2014-7-4 10:47 编辑

1993063 发表于 2014-7-4 09:19 http://bbs.mjtd.com/static/image/common/back.gif
(Defun C:TT ( / *error*EntMid cmd ss)
      (Defun *error* (x)(setvar 'cmdecho cmd)(princ))
   ...

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

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

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

ymcui 发表于 2014-7-4 13:39:07

xyp1964 发表于 2014-7-4 13:12 static/image/common/back.gif


呵呵,院长出手就知有没有.高
页: [1]
查看完整版本: 1/4镜像增强有了，1/4旋转增强怎样写。