非常好用的块镜像功能，请大神修改下

magicheno · 发表于 2020-9-9 14:51

本帖最后由 magicheno 于 2020-9-9 14:53 编辑

请大神修改下，如果是绕块基点左右或上下镜像，该怎么改呢
原贴地址：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=113811&highlight=%BF%E9%2B%BE%B5%CF%F1
(defun c:cemi  (/ sc a b);;;;各自中心镜像---
  (while (ssget)
(vlax-for       obj
            (vla-get-ActiveSelectionSet
               (vla-get-ActiveDocument (vlax-get-acad-object)))
      (if (not (VL-CATCH-ALL-ERROR-P
               (VL-CATCH-ALL-APPLY
                  'vla-GetBoundingBox
                  (list obj 'a 'b))))
      (progn
         (setq bp(mapcar '*  '(0.5 0.5 0.5)(apply 'mapcar (cons '+ (mapcar 'vlax-safearray->list(list a b))))))
         (setq ep(list (car bp) (1+ (cadr bp)) (caddr bp)))
         (vla-transformby obj (vlax-tmatrix (mirror2dmat bp ep)))
         )
      )
      )
)
  (princ)
  )

(defun mirror2dmat(sp ep / i a0 a1 a2 a3 t1 sp a b)
  (setq i '((-1 0 0) (0 -1 0)(0 0 1)))
  (setq a0(mapcar '- ep sp))
  (setq a1(distance a0 (list 0 0 0)))
  (setq a2(/ 1 a1))
  (setq a3(mapcar '(lambda(y)(* y a2)) a0)
      t1(mapcar '(lambda(x)(mapcar '(lambda(y)(* x y)) a3)) a3)
      t1(mapcar '(lambda(x)(mapcar '(lambda(y)(* 2 y)) x))t1)
      t1(mapcar '(lambda(x y)(mapcar '+ x y)) t1 i))
  (setq sp(mapcar '- sp (mapcar '(lambda(x)(apply '+ (mapcar '* x sp))) t1)))
  (setq a (car t1)
      b (cadr t1))
  (list
(list (car a)(cadr a)(caddr a) (car sp))
(list (car b)(cadr b)(caddr b) (cadr sp))
'(0 0 1 0)
'(0 0 0 1))
)

说明一下：这个是绕中心左右镜像的，如果要绕中心上下镜像则把
(setq ep(list (car bp) (1+ (cadr bp)) (caddr bp)))
改为
(setq ep(list (1+ (car bp))  (cadr bp) (caddr bp)))

start4444 · 发表于 2020-9-9 14:51

(setq bp(mapcar '* '(0.5 0.5 0.5)(apply 'mapcar (cons '+ (mapcar 'vlax-safearray->list(list a b))))))
改为： (setq bp (cdr (assoc 10 (entget (vlax-vla-object->ename obj)))))

magicheno · 发表于 2020-9-9 17:11

本帖最后由 magicheno 于 2020-9-9 17:12 编辑

start4444 发表于 2020-9-9 14:51
(setq bp(mapcar '* '(0.5 0.5 0.5)(apply 'mapcar (cons '+ (mapcar 'vlax-safearray->list(list a b)))) ...

感谢大侠哈对了大侠，这个可以改成框选么多个么
原贴地址
http://bbs.mjtd.com/thread-181625-1-1.html
(defun c:tt5 (/ entname w)
(setvar "PEDITACCEPT" 1)
(setq entname (car (entsel "\n请选择对象:")) w (cdr (assoc 40 (entget entname))))
(command "EXPLODE" entname "" "pedit" "m" "p" "" "w" w "")
(setvar "PEDITACCEPT" 0)
(princ)
)

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

[提问] 非常好用的块镜像功能，请大神修改下

最佳答案

点评