MATCH_BLOCKS_ROTATION_v2.........................free

Command: MBR

Function rotates selected block the same angle as selecte line or base block. Function works correct only with objects orienatated in 2D.

Code:

;;; =================================================
;;;        MATCH_BLOCKS_ROTATION_v2_01.LSP
;;;
;;;        Written by Andrzej Kalinowski,     www.autolisps.blogspot.com
;;;        v2.00 - 16.02.2015
;;;        v2.01 - 01.03.2019 - misc updates
;;;
;;;    Command: MBR
;;;        Function rotates selected block the same angle as selecte line or base block. Function works correct only with objects orienatated in 2D.
;;; =================================================
(vl-load-com)
(defun C:MBR (/ obj1 obj2 pckpt type1 type2 pbazowy rotat_rad pt2)

    ;-----------------------------------------
    ;selection of block to rotate
    ;-----------------------------------------
    (setq obj2 nil)
    (prompt "select block: ")
    (while (= obj2 nil)
        (setq obj2 (ssget "_:S+."))
        (if (= obj2 nil)
            (princ "\nwrong object");then
            (if (> (sslength obj2) 1);else
                (progn
                    (princ "\nselect only one object")(princ)
                    (setq obj2 nil)
                );progn
                (progn ; else
                    (setq obj2 (ssname obj2 0));else
                    (setq  type1 (cdr (assoc 0 (entget obj2) ) ) )
                    (if
                        (not
                            (and
                                (= type1 "INSERT");chekcs if object is block or xref
                            );and
                        );not
                        (setq obj2 nil)
                        ();else
                    );if
                );progn else
            ); if
        ); if
    ); while

    ;-----------------------------------------
    ;selection of base block
    ;-----------------------------------------
    (setq obj1 nil)
    (while (= obj1 nil)
        (setq obj1 (entsel "\nselect reference object: line, block or polyline "))
        (if (/= obj1 nil)
            (progn
                (setq type1 (cdr (assoc 0 (entget (car obj1) ) ) ) ); setq
                (if (and (/= type1 "INSERT") (/= type1 "LINE") (/= type1 "LWPOLYLINE"))
                    (progn
                        (prompt "\nwrong object")
                        (setq obj1 nil)
                    ); progn
                ); if
            ); progn
        ); if
    ); while
    (setq
        pckpt (cadr obj1)
        obj1 (vlax-ename->vla-object (car obj1))
        obj2 (vlax-ename->vla-object obj2)
    );setq
    ;-----------------------------------------
    ;reading of objects rotation
    ;-----------------------------------------
    (cond
        ( (= (vla-get-objectname obj1) "AcDbBlockReference")
            (setq rotat_rad (vlax-get obj1 'Rotation) ) )
        
        ( (= (vla-get-objectname obj1) "AcDbLine")
            (setq rotat_rad (vlax-get obj1 'Angle) ) )
        
        ( (= (vla-get-objectname obj1) "AcDbPolyline")
            (setq rotat_rad (AK_LWPLINE_SEGM_COORDS (vlax-vla-object->ename obj1) pckpt) )
            (terpri)(princ rotat_rad)(princ "\t")
            (setq rotat_rad (angle (car rotat_rad) (cadr rotat_rad) ) )
        )
    );cond
    (vla-put-rotation obj2 rotat_rad)
    (princ)
);defun
;;; =================================================
;;;                    LWPLINE_SEGM_COORDS             
;;; =================================================
(defun AK_LWPLINE_SEGM_COORDS (enam1 pckPT1 / sgm_nr pt1 pt2 cords);returns points in WCS
    (setq
        cords (vlax-get (vlax-ename->vla-object enam1) 'Coordinates)
        sgm_nr (* (fix (vlax-curve-getParamAtPoint enam1 (vlax-curve-getClosestPointTo enam1 pckPT1) )) 2 )
        pt1 (list (nth (+ sgm_nr 0) cords) (nth (+ sgm_nr 1) cords))
        pt2 (list (nth (+ sgm_nr 2) cords) (nth (+ sgm_nr 3) cords))
        pckPT1 (list pt1 pt2)
    );setq
    pckPT1
) ;defun

Example:

Download file: MATCH_BLOCKS_ROTATION_v2.FAS