;;-------------------------=={ Nested Move }==--------------------------;;
;;                                                                      ;;
;;  This program enables the user to move multiple selected objects     ;;
;;  nested within a block or xref (nested to any depth), without        ;;
;;  opening the xref source drawing.                                    ;;
;;                                                                      ;;
;;  Upon calling the program with 'nmove' at the command-line, the      ;;
;;  user is continuously prompted to select objects nested within a     ;;
;;  block or xref to be moved. Similar to the standard move command,    ;;
;;  the user is then prompted to specify a base point & displacement    ;;
;;  for the move operation.                                             ;;
;;                                                                      ;;
;;  The program will then proceed to move the selected object within    ;;
;;  the parent block definition or the xref source drawing, utilising   ;;
;;  an ObjectDBX interface should the xref source drawing be unopened   ;;
;;  in the current drawing session.                                     ;;
;;                                                                      ;;
;;  Upon moving the object: in the case of a block parent, the active   ;;
;;  drawing is regenerated to reflect the modification to the block     ;;
;;  definition across all block references in the drawing; for xrefs,   ;;
;;  the xref source drawing is saved and the xref is reloaded in the    ;;
;;  active drawing.                                                     ;;
;;                                                                      ;;
;;  The program will account for the position, scale, rotation &        ;;
;;  orientation of the parent block or xref relative to the base point  ;;
;;  and displacement vector and will perform successfully under all     ;;
;;  UCS & View settings.                                                ;;
;;                                                                      ;;
;;  Please Note:                                                        ;;
;;  ------------------------------                                      ;;
;;  The act of modifying objects within an xref source drawing involves ;;
;;  saving the external drawing remotely - this action cannot be        ;;
;;  undone within the current drawing and any changes to the external   ;;
;;  drawing must be reset manually.                                     ;;
;;                                                                      ;;
;;  Note that when saving drawings through ObjectDBX, drawing files     ;;
;;  will be saved to the highest version available and drawing file     ;;
;;  thumbnails will be lost until the next manual save.                 ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    10-08-2013                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    26-08-2013                                      ;;
;;                                                                      ;;
;;  - Modified program to move the 'outermost' nested object within     ;;
;;    the parent block or xref.                                         ;;
;;  - Added ability to select multiple nested objects to be moved.      ;;
;;  - Added selection highlighting for visual feedback of selected      ;;
;;    nested objects.                                                   ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    31-08-2013                                      ;;
;;                                                                      ;;
;;  - Fixed bug causing the program to crash when a nested attributed   ;;
;;    block or nested polyline is selected.                             ;;
;;----------------------------------------------------------------------;;

(defun c:lm_block_move ( / old_cmd app dbx def doc dwg dwl han hil lst obj own par pt1 pt2 sel tmp vec vrs imat invm revrefgeom refgeom nmove:entmakex nmove:copynested)
;; Identity Matrix  -  Lee Mac
;; Args: n - matrix dimension

(defun imat ( n / i j l m )
    (repeat (setq i n)
        (repeat (setq j n)
            (setq l (cons (if (= i j) 1. 0.) l) j (1- j))
        )
        (setq m (cons l m) l nil i (1- i))
    )
    m
)
;; Matrix Inverse  -  gile & Lee Mac
;; Uses Gauss-Jordan Elimination to return the inverse of a non-singular nxn matrix.
;; Args: m - nxn matrix

(defun invm ( m / c f p r )
    (defun f ( p m )
        (mapcar '(lambda ( x ) (mapcar '(lambda ( a b ) (- a (* (car x) b))) (cdr x) p)) m)
    )
    (setq m (mapcar 'append m (imat (length m))))
    (while m
        (setq c (mapcar '(lambda ( x ) (abs (car x))) m))
        (repeat (vl-position (apply 'max c) c)
            (setq m (append (cdr m) (list (car m))))
        )
        (if (equal 0. (caar m) 1e-14)
            (setq m nil
                  r nil
            )
            (setq p (mapcar '(lambda ( x ) (/ (float x) (caar m))) (cdar m))
                  m (f p (cdr m))
                  r (cons p (f p r))
            )
        )
    )
    (reverse r)
)
;; RevRefGeom (gile)
;; The inverse of RefGeom

(defun revrefgeom ( ent / ang enx mat ocs )
    (setq enx (entget ent)
          ang (mai_dxf 50 enx)
          ocs (mai_dxf 210 enx)
    )
    (list
        (setq mat
            (mai_mxm
                (list
                    (list (/ 1. (mai_dxf 41 enx)) 0. 0.)
                    (list 0. (/ 1. (mai_dxf 42 enx)) 0.)
                    (list 0. 0. (/ 1. (mai_dxf 43 enx)))
                )
                (mai_mxm
                    (list
                        (list (cos ang)     (sin ang) 0.)
                        (list (- (sin ang)) (cos ang) 0.)
                       '(0. 0. 1.)
                    )
                    (mapcar '(lambda ( v ) (trans v ocs 0 t))
                        '(
                             (1. 0. 0.)
                             (0. 1. 0.)
                             (0. 0. 1.)
                         )
                    )
                )
            )
        )
        (mapcar '- (mai_dxf 10 (tblsearch "block" (mai_dxf 2 enx)))
            (mai_mxv mat (trans (mai_dxf 10 en)) ocs 0)
        )
    )
)

;; RefGeom (gile)
;; Returns a list whose first item is a 3x3 transformation matrix and
;; second item the object insertion point in its parent (xref, block or space)

(defun refgeom ( ent / ang enx mat ocs )
    (setq enx (entget ent)
          ang (mai_dxf 50 enx)
          ocs (mai_dxf 210 enx)
    )
    (list
        (setq mat
            (mai_mxm
                (mapcar '(lambda ( v ) (trans v 0 ocs t))
                   '(
                        (1. 0. 0.)
                        (0. 1. 0.)
                        (0. 0. 1.)
                    )
                )
                (mai_mxm
                    (list
                        (list (cos ang) (- (sin ang)) 0.)
                        (list (sin ang) (cos ang)     0.)
                       '(0. 0. 1.)
                    )
                    (list
                        (list (mai_dxf 41 enx) 0. 0.)
                        (list 0. (mai_dxf 42 enx) 0.)
                        (list 0. 0. (mai_dxf 43 enx))
                    )
                )
            )
        )
        (mapcar '- (trans (mai_dxf 10 enx) ocs 0)
            (mai_mxv mat (mai_dxf 10 (tblsearch "block" (mai_dxf 2 enx))))
        )
    )
)

(defun nmove:entmakex ( enx )
    (entmakex
        (append
            (vl-remove-if
                   '(lambda ( x )
                        (or (member (car x) '(5 6 8 39 48 62 102 370))
                            (= 'ename (type (cdr x)))
                        )
                    )
                    enx
            )
           '(
                (6 . "CONTINUOUS")
                (8 . "0")
                (39 . 0.)
                (48 . 1.)
                (62 . 7)
                (370 . 0)
            )
        )
    )
)

(defun nmove:copynested ( ent / enx)
    (if (= 1 (mai_dxf 66 (setq enx (entget ent))))
        (progn
            (nmove:entmakex enx)
            (setq ent (entnext ent)
                  enx (entget  ent)
            )
            (while (/= "SEQEND" (mai_dxf 0 enx))
                (nmove:entmakex enx)
                (setq ent (entnext ent)
                      enx (entget  ent)
                )
            )
            (mai_dxf 330 (nmove:entmakex enx))
        )
        (nmove:entmakex enx)
    )
)



    (mini_start nil)
    (while
        (progn (setvar 'errno 0) (setq sel (nentselp "\nÑ¡ÔñÇ¶Ì×ÊµÌåÒÆ¶¯: <»Ø³µÍË³ö>"))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\n¿ÕÑ¡£¬ÔÙÊÔÒ»´Î.")
                )
                (   (null sel)
                    nil
                )
                (   (or (= 2 (length sel))
                        (/= "INSERT" (mai_dxf 0 (setq own (last (last sel)))))
                    )
                    (princ "\n²»ÊÇ¡¾¿é»òÍâ²¿²ÎÕÕ¡¿µÄÄÚ²¿ÊµÌå.")
                )
                (   (= :vlax-true (vla-get-isdynamicblock (vlax-ename->vla-object own)))
                    (princ "\nÕâ¸öÃüÁî²»Ö§³Ö¡¾¶¯Ì¬¿é¡¿ÄÚ²¿ÊµÌå.")
                )
                (   (and (= 'ename (type par)) (not (eq par own)))
                    (princ "\nObject is nested within a different parent.")
                )
                (   t
                    (or par (setq par own))
                    (if (wcmatch (mai_dxf 0 (car sel)) "ATTRIB,VERTEX")
                        (setq sel (cons (mai_dxf 330 (car sel)) (cdr sel)))
                    )
                    (if (cdr (last sel))
                        (setq lst (cons (cons (cadr (reverse (last sel))) (car (revrefgeom par))) lst))
                        (setq lst (cons (cons (car sel) (mapcar 'mai_rcdr (mai_rcdr (invm (caddr sel))))) lst))
                    )
                    (if (setq tmp (nmove:copynested (caar lst)))
                        (progn
                            (vla-transformby (vlax-ename->vla-object tmp)
                                (vlax-tmatrix
                                    (if (cdr (last sel))
                                        (append
                                            (apply 'mapcar
                                                (cons '(lambda ( r v ) (append r (list v)))
                                                    (refgeom par)
                                                )
                                            )
                                           '((0. 0. 0. 1.))
                                        )
                                        (caddr sel)
                                    )
                                )
                            )
                            (redraw tmp 3)
                            (setq hil (cons tmp hil))
                        )
                    )
                    t
                )
            )
        )
    )
    (cond
        (   (not
                (and
                    (= 'list (type lst))
                    (setq pt1 (getpoint "\nÒÆ¶¯»ùµã:<»Ø³µÍË³ö>"))
                    (setq pt2 (getpoint "\nÒÆ¶¯µ½µã:<»Ø³µÍË³ö>" pt1))
                    (setq vec (mapcar '- (trans pt2 1 0) (trans pt1 1 0)))
                )
            )
        )
        (   (zerop (logand 4 (mai_dxf 70 (setq def (tblsearch "block" (mai_block_name (vlax-ename->vla-object par)))))))
            (foreach itm lst
                (if (vlax-write-enabled-p (setq obj (vlax-ename->vla-object (car itm))))
                    (vla-move obj
                        (vlax-3D-point 0 0)
                        (vlax-3D-point (mai_mxv (cdr itm) vec))
                    )
                    (princ (strcat "\n¾ä±úÃûÎª¡¾ \"" (vla-get-handle obj) "\" ¡¿µÄÊµÌåÔÚ±»Ëø¶¨µÄ²ãÉÏ."))
                )
            )
            (vla-regen (LM:acdoc) acallviewports)
        )
        (   (progn
                (setq app (vlax-get-acad-object)
                      vrs (atoi (getvar 'acadver))
                      dbx (vl-catch-all-apply 'vla-getinterfaceobject
                             (list app (if (< vrs 16) "objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))))
                          )
                )
                (and dbx (vl-catch-all-error-p dbx))
            )
            (prompt "\nÎÞ·¨·ÃÎÊ ObjectDBX.")
        )
        (   (or
                (not (setq dwg (findfile (mai_dxf 1 def))))
                (progn
                    (vlax-for doc (vla-get-documents app)
                       (setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
                    )
                    (not (setq doc (mai_dxf (strcase dwg) dwl)))
                )
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg))))
                (not (setq doc dbx))
            )
            (princ "\nÎÞ·¨·ÃÎÊÍâ²¿²ÎÕÕÔ´ÎÄ¼þ.")
        )
        (   t
            (foreach itm lst
                (setq han (mai_dxf 5 (car itm))
                      obj (vl-catch-all-apply 'vla-handletoobject (list doc han))
                )
                (cond
                    (   (vl-catch-all-error-p obj)
                        (princ (strcat "\nÎÞ·¨¶¨Î»ÔÚÍâ²¿²ÎÕÕÔ´ÎÄ¼þ¾ä±úÃûÎª¡¾ \"" han "\"¡¿µÄÊµÌå."))
                    )
                    (   (vlax-write-enabled-p obj)
                        (vla-move obj
                            (vlax-3D-point 0 0)
                            (vlax-3D-point (mai_mxv (cdr itm) vec))
                        )
                    )
                    (   (princ (strcat "\nÍâ²¿²ÎÕÕÔ´ÎÄ¼þÄÚ¾ä±úÃûÎª ¡¾\"" han "\"¡¿ ÊµÌåÔÚÒ»¸ö±»Ëø¶¨µÄ²ãÉÏ.")))
                )
            )
            (vla-saveas doc dwg)
            (vla-reload (vla-item (vla-get-blocks (LM:acdoc)) (mai_dxf 2 def)))
        )
    )
    (mai_end)
)





(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
