[编程交流] 三维，通过拾取面对齐

; Pick 3D Object's face
; Attempt to align objects by picking faces:
; 1.Select objects to align (SS)
; 2.Pick Source Face
; 3.Pick Destination Face
; 4.The SS is aligned, where the Source Face and Destination Face share the same plane, and their centroids are matched
;      *******************x <- mx
;      *                  *
;      *                  *
;      *        x <-cenx  *
;      *                  *
;      *                  *
; mn-> x*******************
;
; Points mn, mx and cenx are collinear!
; Grrr
; Credits to: Lee Mac
(defun C:test ( / SS msg continiue pt1 bpoly-ent1 bpoly-elist1 vla-bpoly1 mn1 mx1 box1 bpolys-cen1 pt2 bpoly-ent2 bpoly-elist2 vla-bpoly2 mn2 mx2 box2 bpolys-cen2)
(if
        (and
                (princ "\nSelect objects to align, by picking faces")
                (setq SS (ssget "_:L"))
                (sssetfirst nil SS)
        )
        (progn
                ; Will prompt for point, until the bpoly's elist is displayed:
                ; Picking Source Face:
                (setq continiue T)
                (while
                        continiue
                        (progn
                                (setq pt1 (getpoint "\nPick the source face"))
                                (command "_.UCS" "F" pt1 "")
                                (command "_.BPOLY" pt1 "")
                                (if        
                                        (and
                                                (eq (cdr (assoc 0 (entget (entlast)))) "LWPOLYLINE")
                                                (not (member msg '("Function cancelled" "quit / exit abort" "Valid hatch boundary not found.")))
                                        )
                                        (progn
                                                
                                                (setq bpoly-ent1 (entlast))
                                                (setq bpoly-elist1 (entget bpoly-ent1))
                                                (setq vla-bpoly1 (vlax-ename->vla-object bpoly-ent1))
                                                (setq box1 (vla-getboundingbox vla-bpoly1 'mns 'mxs))
                                                (setq bpolys-cen1 
                                                        ( mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0))
                                                                (setq mn1 (trans (vlax-safearray->list mns) 1 1))
                                                                (setq mx1 (trans (vlax-safearray->list mxs) 1 1)) 
                                                        )
                                                )
                                                (entmakex 
                                                        (list 
                                                                (cons 0 "POINT")
                                                                (cons 10 bpolys-cen1)
                                                        )
                                                )
                                                (entdel bpoly-ent1)
                                                (command "_.UCS" "W" )
                                                (setq continiue F)
                                                ; how to set (entlast) to nil ? or not to be a (cons 0 LWPOLYLINE) ? So the code would reset
                                        )
                                        (princ "\n*** Try again! ***")
                                )
                        )
                )
                
                ; Picking Destination Face:
                (setq continiue T)
                (while
                        continiue
                        (progn
                                (setq pt2 (getpoint "\nPick the destination face"))
                                (command "_.UCS" "F" pt2 "")
                                (command "_.BPOLY" pt2 "")
                                (if        
                                        (and
                                                (eq (cdr (assoc 0 (entget (entlast)))) "LWPOLYLINE")
                                                (not (member msg '("Function cancelled" "quit / exit abort" "Valid hatch boundary not found.")))
                                        )
                                        (progn
                                                
                                                (setq bpoly-ent2 (entlast))
                                                (setq bpoly-elist2 (entget bpoly-ent1))
                                                (setq vla-bpoly1 (vlax-ename->vla-object bpoly-ent2))
                                                (setq box2 (vla-getboundingbox vla-bpoly2 'mnz 'mxz))
                                                (setq bpolys-cen2 
                                                        ( mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0))
                                                                (setq mn2 (trans (vlax-safearray->list mnz) 1 1))
                                                                (setq mx2 (trans (vlax-safearray->list mxz) 1 1)) 
                                                        )
                                                )
                                                (entmakex 
                                                        (list 
                                                                (cons 0 "POINT")
                                                                (cons 10 bpolys-cen2)
                                                        )
                                                )
                                                (entdel bpoly-ent2)
                                                (command "_.UCS" "W" )
                                                (setq continiue F)
                                                ; how to set (entlast) to nil ? or not to be a (cons 0 LWPOLYLINE) ? So the code would reset
                                        )
                                        (princ "\n*** Try again! ***")
                                )
                        )
                )
                
                (command "_.3DALIGN" SS ""
                        bpolys-cen1 mn1 mx1 ; the points must not be collinear! (in this example they are)
                        bpolys-cen2 mn2 mx2 ; the points must not be collinear! (in this example they are)
                )
        );progn
);if
(princ)
);defun                

我的目标是表示与Autodesk Inventor的对齐，请参见此示例视频
从1:37开始，粉红色部分与棕色部分对齐。（至少与此相近）。 
目前，我遇到了一些问题，要找到“第三个”非共线点进行对齐。在下图中，您可以看到黄色的临时bpoly，以及红色的当前点：

 
如果您有更好的建议，请随意修改代码。
对我来说，写这样的代码是一种爱好，我不是一个真正的程序员，所以我不需要任何学分。
（是的，我想为什么不使用bpoly的顶点呢？但我花了几天的时间才弄明白）