非常好用的块镜像功能，请大神修改下
本帖最后由 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)))
(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: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)
)
页:
[1]