（解决了）带角度的镜像
本帖最后由 sandyvs 于 2023-6-5 20:53 编辑已解决，
本帖最后由 sandyvs 于 2023-6-5 14:47 编辑
(defun c:mij ( / ang ent moveDist moveToPoint moveVec pt0 pt1 pt2 pt3 ss ss1 vlaObj vlaObjCopy y)
(vl-load-com)
(setq ang (getangle "\n输入或指定角度："))
(setq ss(ssget))
(setq pt1 (getpoint "\n指定镜像线的第一个点："))
(setq pt2 (getpoint pt1 "\n指定镜像线的第二个点："))
(setq ss1 (ssadd))
(repeat (sslength ss)
(setq ent (ssname ss 0)) ; 获取选择集中的第一个对象
(setq pt0(lm-get-Centroid ent))
(setq vlaObj (vlax-ename->vla-object ent)) ; 将实体名称转换为 VLA 对象
(setq y (* -2 (- (cadr pt0) (cadr pt1))))
(setq moveDist (/ y (s_tan ang)))
(setq pt3 (mapcar '+ pt1 pt2))
(setq pt3 (mapcar '/ pt3 '(2 2 2))) ; 计算镜像线中点
(setq vlaObjCopy(vla-Mirror vlaObj (vlax-3D-point pt1) (vlax-3D-point pt2)) ); 镜像对象
(ssadd (vlax-vla-object->ename vlaObjcopy) ss1)
; 计算从镜像线中点到镜像对象的移动矢量
(setq moveVec (list moveDist 0.0 0.0))
(setq moveToPoint (mapcar '+ pt3 moveVec))
(vla-move vlaObjCopy (vlax-3D-point pt3) (vlax-3D-point moveToPoint)) ; 移动镜像对象
(ssdel ent ss) ; 从选择集中删除已处理实体
)
(sssetfirst nil ss1)
(cemi ss1)
(princ)
)
(defun s_tan (A1);正切函数;输入弧角度如π。
(if (= (cos A1) 0) (sin A1) (/ (sin A1) (cos A1)))
)
(defun cemi(ss / sc a b);;;;各自中心镜像---http://bbs.mjtd.com/forum.php?mod=viewthread&tid=113811&highlight=%D4%AD%B5%D8%2B%BE%B5%CF%F1
(if ss
(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)));;左右镜像
(setq ep(list (1+ (car bp))(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))
)
(defun lm-get-Centroid (ty / obj pt x y)
(setq obj (vlax-ename->vla-object ty))
(vla-getboundingbox obj 'p1 'p2)
(mapcar 'set'(x1 y1) (vlax-safearray->list p1 ))
(mapcar 'set'(x2 y2) (vlax-safearray->list p2 ))
(setq pt(list (/(+ x1 x2)2.0) (/(+ y1 y2)2.0)))
pt
)
sandyvs 发表于 2023-6-5 11:01
(defun c:mij ( / ang ent moveDist moveToPoint moveVec pt0 pt1 pt2 pt3 ss ss1 vlaObj vlaObjCopy y)
...
(defun c:mij ( / ang ent moveDist moveToPoint moveVec pt0 pt1 pt2 pt3 ss ss1 vlaObj vlaObjCopy y)
(vl-load-com)
(setq ang (getangle "\n输入或指定角度："))
(setq ss(ssget))
(setq pt1 (getpoint "\n指定镜像线的第一个点："))
(setq pt2 (getpoint pt1 "\n指定镜像线的第二个点："))
(setq ss1 (ssadd) i 0)
(repeat (sslength ss)
(setq ent (ssname ss i)) ; 获取选择集中的第一个对象
(setq pt0(lm-get-Centroid ent))
(setq vlaObj (vlax-ename->vla-object ent)) ; 将实体名称转换为 VLA 对象
(setq y (* -2 (- (cadr pt0) (cadr pt1))))
(setq moveDist (/ y (s_tan ang)))
(setq pt3 (mapcar '+ pt1 pt2))
(setq pt3 (mapcar '/ pt3 '(2 2 2))) ; 计算镜像线中点
(setq vlaObjCopy(vla-Mirror vlaObj (vlax-3D-point pt1) (vlax-3D-point pt2)) ); 镜像对象
(ssadd (vlax-vla-object->ename vlaObjcopy) ss1)
; 计算从镜像线中点到镜像对象的移动矢量
(setq moveVec (list moveDist 0.0 0.0))
(setq moveToPoint (mapcar '+ pt3 moveVec))
(vla-move vlaObjCopy (vlax-3D-point pt3) (vlax-3D-point moveToPoint)) ; 移动镜像对象
(setq i (1+ i))
)
(cemi ss1)
(princ)
)
(defun s_tan (A1);正切函数;输入弧角度如π。
(if (= (cos A1) 0) (sin A1) (/ (sin A1) (cos A1)))
)
(defun cemi(ss / sc a b);;;;各自中心镜像---http://bbs.mjtd.com/forum.php?mo ... 5%D8%2B%BE%B5%CF%F1
(if ss
(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)));;左右镜像
(setq ep(list (1+ (car bp))(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)
)
)
(defun lm-get-Centroid (ty / obj pt x y)
(setq obj (vlax-ename->vla-object ty))
(vla-getboundingbox obj 'p1 'p2)
(mapcar 'set'(x1 y1) (vlax-safearray->list p1 ))
(mapcar 'set'(x2 y2) (vlax-safearray->list p2 ))
(setq pt(list (/(+ x1 x2)2.0) (/(+ y1 y2)2.0)))
pt
) 飞雪神光 发表于 2023-6-5 17:36
还是有问题。。
页:
[1]