(MYM)管接头放样线归置

;;说明:管接头放样线归置
(defun C:MYM(/ bf-pickset->list bf-translation isptinrectang lss pss pt1 pt2)
    (defun BF-Translation (p0 p1 / v)
        (setq v (mapcar '- p1 p0))
        (list
            (list 1. 0. 0. (float (car v)))
            (list 0. 1. 0. (float (cadr v)))
            (list 0. 0. 1. (float (caddr v)))
            (list 0. 0. 0. 1.)
        )
    )
    (defun IsPtInRectang(p1 p2 p) (vl-every '>= (mapcar '* (mapcar '- p p1) (mapcar '- p2 p)) '(0 0)))
    (defun BF-pickset->list (SS / bf-enamep) (defun BF-enamep (arg) (equal (type arg) 'ename)) (vl-remove-if-not 'BF-enamep (mapcar 'cadr (ssnamex SS))))
    (if (and (setq pt1 (getpoint "\n指定第一个角点：")) (setq pt2 (getcorner pt1 "指定第二个角点，确保移动点在框内：")) (princ "\n请选择需要放置的直线：") (setq lss (ssget '((0 . "LINE")))) (princ "\n请框选放置点：") (setq pss (ssget '((0 . "POINT")))))
        (progn
            (setq lss (BF-pickset->list lss) lss (vl-sort lss (function (lambda(e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))))
            (setq pss (BF-pickset->list pss) pss (vl-sort pss (function (lambda(e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2))))))))
            (mapcar
                (function
                    (lambda(l p)
                        (setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)) edata (entget l) d10 (cdr (assoc 10 edata)) d11 (cdr (assoc 11 edata)))
                        (vlax-safearray-fill
                            mat
                            (BF-Translation 
                                (if (IsPtInRectang pt1 pt2 d10) d10 d11)
                                (cdr (assoc 10 (entget p)))
                            )
                        )
                        (vla-TransformBy (vlax-ename->vla-object l) mat)
                    )
                )
                lss
                pss
            )
        )
    )
    (prin1)
)