（解决了）带角度的镜像

sandyvs

已解决，

sandyvs

(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?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
)

飞雪神光

sandyvs 发表于 2023-6-5 11:01
(defun c:mij ( / ang ent moveDist moveToPoint moveVec pt0 pt1 pt2 pt3 ss ss1 vlaObj vlaObjCopy y)
...

1. (defun c:mij ( / ang ent moveDist moveToPoint moveVec pt0 pt1 pt2 pt3 ss ss1 vlaObj vlaObjCopy y)
   
2.   (vl-load-com)
   
3.   (setq ang (getangle "\n输入或指定角度："))
   
4.   (setq ss(ssget))
   
5.   (setq pt1 (getpoint "\n指定镜像线的第一个点："))
   
6.   (setq pt2 (getpoint pt1 "\n指定镜像线的第二个点："))
   
7.   (setq ss1 (ssadd) i 0)
   
8.   (repeat (sslength ss)
   
9.     (setq ent (ssname ss i)) ; 获取选择集中的第一个对象
   
10.     (setq pt0(lm-get-Centroid ent))
    
11.     (setq vlaObj (vlax-ename->vla-object ent)) ; 将实体名称转换为 VLA 对象
    
12.                 (setq y (* -2 (- (cadr pt0) (cadr pt1))))
    
13.                 (setq moveDist (/ y (s_tan ang)))
    
14.     (setq pt3 (mapcar '+ pt1 pt2))
    
15.     (setq pt3 (mapcar '/ pt3 '(2 2 2))) ; 计算镜像线中点
    
16.     (setq vlaObjCopy(vla-Mirror vlaObj (vlax-3D-point pt1) (vlax-3D-point pt2)) ); 镜像对象
    
17.     (ssadd (vlax-vla-object->ename vlaObjcopy) ss1)
    
18.     ; 计算从镜像线中点到镜像对象的移动矢量
    
19.     (setq moveVec (list moveDist 0.0 0.0))
    
20.     (setq moveToPoint (mapcar '+ pt3 moveVec))
    
21.     (vla-move vlaObjCopy (vlax-3D-point pt3) (vlax-3D-point moveToPoint)) ; 移动镜像对象
    
22.                 (setq i (1+ i))
    
23.   )
    
24.   (cemi ss1)
    
25.   (princ)
    
26. )
    
27. (defun s_tan (A1);正切函数;输入弧角度如π。
    
28.         (if (= (cos A1) 0) (sin A1) (/ (sin A1) (cos A1)))
    
29. )
    
30. 
    
31. (defun cemi  (ss / sc a b);;;;各自中心镜像---http://bbs.mjtd.com/forum.php?mo ... 5%D8%2B%BE%B5%CF%F1
    
32.   (if ss
    
33.     (vlax-for obj
    
34.                         (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
    
35.                         (if (not (VL-CATCH-ALL-ERROR-P  (VL-CATCH-ALL-APPLY  'vla-GetBoundingBox (list obj 'a 'b))))
    
36.                                 (progn
    
37.                                         (setq bp(mapcar '*  '(0.5 0.5 0.5)(apply 'mapcar (cons '+ (mapcar 'vlax-safearray->list(list a b))))))
    
38.                                         ;(setq ep(list (car bp) (1+ (cadr bp)) (caddr bp)));;左右镜像
    
39.                                         (setq ep(list (1+ (car bp))  (cadr bp) (caddr bp)));;上下镜像
    
40.                                         (vla-transformby obj (vlax-tmatrix (mirror2dmat bp ep)))
    
41.                                 )
    
42.                         )
    
43.                 )
    
44.         )
    
45.   (princ)
    
46. )
    
47. 
    
48. (defun mirror2dmat(sp ep / i a0 a1 a2 a3 t1 sp a b)
    
49.   (setq i '((-1 0 0) (0 -1 0)(0 0 1)))
    
50.   (setq a0(mapcar '- ep sp))
    
51.   (setq a1(distance a0 (list 0 0 0)))
    
52.   (setq a2(/ 1 a1))
    
53.   (setq
    
54.                 a3(mapcar '(lambda(y)(* y a2)) a0)
    
55.                 t1(mapcar '(lambda(x)(mapcar '(lambda(y)(* x y)) a3)) a3)
    
56.                 t1(mapcar '(lambda(x)(mapcar '(lambda(y)(* 2 y)) x))t1)
    
57.                 t1(mapcar '(lambda(x y)(mapcar '+ x y)) t1 i)
    
58.         )
    
59.   (setq sp(mapcar '- sp (mapcar '(lambda(x)(apply '+ (mapcar '* x sp))) t1)))
    
60.   (setq
    
61.                 a (car t1)
    
62.                 b (cadr t1)
    
63.         )
    
64.   (list
    
65.     (list (car a)(cadr a)(caddr a) (car sp))
    
66.     (list (car b)(cadr b)(caddr b) (cadr sp))
    
67.     '(0 0 1 0)
    
68.     '(0 0 0 1)
    
69.         )
    
70. )
    
71. (defun lm-get-Centroid (ty / obj pt x y)
    
72.         (setq obj (vlax-ename->vla-object ty))
    
73.         (vla-getboundingbox obj 'p1 'p2)
    
74.         (mapcar 'set'(x1 y1) (vlax-safearray->list p1 ))
    
75.         (mapcar 'set'(x2 y2) (vlax-safearray->list p2 ))
    
76.         (setq pt(list (/(+ x1 x2)2.0) (/(+ y1 y2)2.0)))
    
77.         pt
    
78. )

(defun c:mij ( / ang ent moveDist moveToPoint moveVec pt0 pt1 pt2 pt3 ss ss1 vlaObj vlaObjCopy y)<br />   (vl-load-com)<br />   (setq ang (getangle "\n输入或指定角度："))<br />   (setq ss(ssget))<br />   (setq pt1 (getpoint "\n指定镜像线的第一个点："))<br />   (setq pt2 (getpoint pt1 "\n指定镜像线的第二个点："))<br />   (setq ss1 (ssadd) i 0)<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i)) ; 获取选择集中的第一个对象<br />     (setq pt0(lm-get-Centroid ent))<br />     (setq vlaObj (vlax-ename->vla-object ent)) ; 将实体名称转换为 VLA 对象<br />                 (setq y (* -2 (- (cadr pt0) (cadr pt1))))<br />                 (setq moveDist (/ y (s_tan ang)))<br />     (setq pt3 (mapcar '+ pt1 pt2))<br />     (setq pt3 (mapcar '/ pt3 '(2 2 2))) ; 计算镜像线中点<br />     (setq vlaObjCopy(vla-Mirror vlaObj (vlax-3D-point pt1) (vlax-3D-point pt2)) ); 镜像对象<br />     (ssadd (vlax-vla-object->ename vlaObjcopy) ss1)<br />     ; 计算从镜像线中点到镜像对象的移动矢量<br />     (setq moveVec (list moveDist 0.0 0.0))<br />     (setq moveToPoint (mapcar '+ pt3 moveVec))<br />     (vla-move vlaObjCopy (vlax-3D-point pt3) (vlax-3D-point moveToPoint)) ; 移动镜像对象<br />                 (setq i (1+ i))<br />   )<br />   (cemi ss1)<br />   (princ)<br /> )<br /> (defun s_tan (A1);正切函数;输入弧角度如π。<br />         (if (= (cos A1) 0) (sin A1) (/ (sin A1) (cos A1)))<br /> )<br /> <br /> (defun cemi  (ss / sc a b);;;;各自中心镜像---<a href="http://bbs.mjtd.com/forum.php?mo" target="_blank">http://bbs.mjtd.com/forum.php?mo</a> ... 5%D8%2B%BE%B5%CF%F1<br />   (if ss<br />     (vlax-for obj<br />                         (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))<br />                         (if (not (VL-CATCH-ALL-ERROR-P  (VL-CATCH-ALL-APPLY  'vla-GetBoundingBox (list obj 'a 'b))))<br />                                 (progn<br />                                         (setq bp(mapcar '*  '(0.5 0.5 0.5)(apply 'mapcar (cons '+ (mapcar 'vlax-safearray->list(list a b))))))<br />                                         ;(setq ep(list (car bp) (1+ (cadr bp)) (caddr bp)));;左右镜像<br />                                         (setq ep(list (1+ (car bp))  (cadr bp) (caddr bp)));;上下镜像<br />                                         (vla-transformby obj (vlax-tmatrix (mirror2dmat bp ep)))<br />                                 )<br />                         )<br />                 )<br />         )<br />   (princ)<br /> )<br /> <br /> (defun mirror2dmat(sp ep / i a0 a1 a2 a3 t1 sp a b)<br />   (setq i '((-1 0 0) (0 -1 0)(0 0 1)))<br />   (setq a0(mapcar '- ep sp))<br />   (setq a1(distance a0 (list 0 0 0)))<br />   (setq a2(/ 1 a1))<br />   (setq <br />                 a3(mapcar '(lambda(y)(* y a2)) a0)<br />                 t1(mapcar '(lambda(x)(mapcar '(lambda(y)(* x y)) a3)) a3)<br />                 t1(mapcar '(lambda(x)(mapcar '(lambda(y)(* 2 y)) x))t1)<br />                 t1(mapcar '(lambda(x y)(mapcar '+ x y)) t1 i)<br />         )<br />   (setq sp(mapcar '- sp (mapcar '(lambda(x)(apply '+ (mapcar '* x sp))) t1)))<br />   (setq <br />                 a (car t1)<br />                 b (cadr t1)<br />         )<br />   (list<br />     (list (car a)(cadr a)(caddr a) (car sp))<br />     (list (car b)(cadr b)(caddr b) (cadr sp))<br />     '(0 0 1 0)<br />     '(0 0 0 1)<br />         )<br /> )<br /> (defun lm-get-Centroid (ty / obj pt x y)<br />         (setq obj (vlax-ename->vla-object ty))<br />         (vla-getboundingbox obj 'p1 'p2)<br />         (mapcar 'set'(x1 y1) (vlax-safearray->list p1 ))<br />         (mapcar 'set'(x2 y2) (vlax-safearray->list p2 ))<br />         (setq pt(list (/(+ x1 x2)2.0) (/(+ y1 y2)2.0)))<br />         pt<br /> )

sandyvs

飞雪神光 发表于 2023-6-5 17:36

还是有问题。。