;;;=================================================================
;;;
;;; RINS.LSP V3.00
;;;
;;; Redéfinir le point d'insertion des blocs
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:rins(/ bl dec deh doc ent js n nom_bl lst1 lst2 pt rep rota)

  (defun rota(pt bas rot / lay lck po)
    (setq lay (vla-item (vla-get-layers doc) (getvar "clayer")))
    (and (eq (vla-get-lock lay) :vlax-true)
      (setq lck T)
      (vla-put-lock lay :vlax-false)
    )
    (setq po (vla-addpoint (if (eq (getvar "cvport") 1)
			     (vla-get-paperspace doc)
			     (vla-get-modelspace doc)
			   )
			   (vlax-3d-point pt)
	     )
    )
    (vla-rotate po (vlax-3d-point bas) rot)
    (setq pt (vlax-get po 'coordinates))
    (vla-delete po)
    (and lck (vla-put-lock lay :vlax-true))
    pt
  )

  (defun nom_bl(bl)
    (if (vlax-property-available-p bl 'effectivename)
      (vla-get-effectivename bl)
      (vla-get-name bl)
    )
  )

  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (if (ssget (list (cons 0 "INSERT")))
    (progn
      (vlax-for bl (setq js (vla-get-activeselectionset doc))
	(or (member (setq nom (nom_bl bl)) lst2)
	  (setq lst1 (cons bl lst1)
		lst2 (cons nom lst2)
	  )
	)
      )
      (vla-delete js)
      (initget "Oui Non _Yes _No")
      (setq rep (getkword "\nDésirez-vous conserver l'emplacement actuel des blocs <O> : "))
      (or rep
	(setq rep "Oui")
      )
      (foreach ent (reverse lst1)
	(vla-highlight ent :vlax-true)
	(while (not (setq pt (getpoint "\nVeuillez sélectionner son nouveau point de base : "))))
	(vla-highlight ent :vlax-false)
	(setq bl  (vla-item (vla-get-blocks doc) (setq nom (nom_bl ent)))
	      dec (mapcar '- (rota (trans pt 1 0) (vlax-get ent 'insertionpoint) (- (vlax-get ent 'rotation))) (vlax-get ent 'insertionpoint))
	      deh (mapcar '/ dec (list (vlax-get ent 'xscalefactor) (vlax-get ent 'yscalefactor) (vlax-get ent 'zscalefactor)))
	)
	(vlax-put bl 'origin (mapcar '+ (vlax-get bl 'origin) deh))
	(if (ssget "x" (list (cons 0 "INSERT") (cons 2 (strcat nom ",`**"))))
	  (progn
	    (vlax-for ent (setq js (vla-get-activeselectionset doc))
	      (and (eq rep "Oui") (eq (strcase (nom_bl ent)) (strcase nom))
		(setq dec (mapcar '* (rota deh '(0.0 0.0 0.0) (vlax-get ent 'rotation)) (list (vlax-get ent 'xscalefactor) (vlax-get ent 'yscalefactor) (vlax-get ent 'zscalefactor))))
		(vlax-put-property ent 'insertionpoint (vlax-3d-point (mapcar '+ (vlax-get ent 'insertionpoint) dec)))
	      )
	    )
	    (vla-delete js)
	    (princ (strcat "\nModification du point de base pour le bloc \"" nom "\" effectué."))
	  )
	)
      )
    )
    (princ "\nPas de bloc de sélectionné.")
  )
  (vla-endundomark doc)
  (princ)
)

(setq nom_lisp "RINS")
(if (/= app nil)
  (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
    (princ (strcat "..." nom_lisp " chargé."))
    (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
  (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)