drag & drop image

[GeryKnee]

Need a lisp for draging & droping an image

1) If no layer ex named "MyImagesLayer" cretes it

2) the image draged and droped put on this layer. The current layer not changes.

Thanks

[Moshe-A · Accepted solution]

@GeryKnee  hi,

this one is based on command reactor.  wrap the following code lines in a lisp file and load it with appload startup suite

the (vlr-command-reactor) has a dotted pair data argument:

("GeryKnee" . "MyImagesLayer")

where the first item is your name serves as reactor id and the second item is the requested layer name. you need to fill it with your layer name.

wonder,  have you thought about what will happen if you want to drag an image to other layer?  😀  

enjoy

moshe

(vl-load-com); load activex support

(defun OnCommandStart (Reactor data^)
 nil
)

(defun OnCommandEnded (Reactor data^ / rdata layName doc layers lay ename elist AcDbImage)
 (setq rdata (vlr-data Reactor))
 (setq layName (cdr rdata)) 
  
 (if (and
       (eq (car rdata) "GeryKnee") ; check cmdReactor Id
       (eq (strcase (car data^)) "-IMAGE")
      )
  (progn 
   (if (null (tblsearch "layer" (cdr rdata)))
    (progn
     (setq doc (vla-get-activedocument (vlax-get-acad-object)))
     (setq layers (vla-get-layers doc))
     (setq lay (vla-add layers layName))
    ); progn
   ); if
   
   (if (and
	 (setq ename (entlast))
	 (setq elist (entget ename))
	 (eq (cdr (assoc '0 elist)) "IMAGE")
       )
    (progn  
     (setq AcDbImage (vlax-ename->vla-object ename))
     (vla-put-layer AcDbImage layName)
     (vlax-release-object AcDbImage)
    ); progn
   ); if

   (if (and lay (eq lay 'VLA-OBJECT))
    (progn
     ; dispose memory
     (vlax-release-object lay)
     (vlax-release-object layers)
     (vlax-release-object doc)
    ); progn
   ); if
     
  ); progn
 ); if
); OnCommandEnded


; install reactor
(if (or (not cmdReactor)
	(vlr-added-p cmdReactor)
    )
					  ; cmdReactor Id + Requeted Layer Name
  (setq cmdReactor (vlr-command-reactor  '("GeryKnee"     . "MyImagesLayer")
						'((:vlr-commandWillStart . OnCommandStart)
					       	  (:vlr-commandEnded     . OnCommandEnded)
					         )
		   )
  ); setq
); if

[hak_vz]

Since drag and drop is not a command you may use this.

(defun c:pimage ( / old lyr ent)
(defun *error* ()(princ))
(setq
    old (getvar "clayer")
    lyr (tblsearch "layer" "MyImagesLayer")
    ent (entget(entlast))
 )
 (setvar "cmdecho" 0)
(if (not lyr)  (command "._layer" "_M" "MyImagesLayer"  "_Lt" "Continuous" "MyImagesLayer" ""))

(if (= (cdr (assoc 0 ent)) "image")
(alert "aaaaa")
    (progn
        (setq ent (subst (cons 8 "MyImagesLayer" ) (assoc 8 ent) ent))
        (setq ent (entmod ent))
    )
)  
(command "._layer" "_s" old "")
(setvar "cmdecho" 1)  
(princ)
)

After you paste your image into the drawing, start command PIMAGE to change its layer to "MyImagesLayer".

Other option is to use reactors as in @Moshe-A  sample. Each option has its own plus and minus,

[hak_vz]

Correct code:

(defun c:pimage ( / old lyr ent)
(defun *error* ()(princ))
(setq
    old (getvar "clayer")
    lyr (tblsearch "layer" "MyImagesLayer")
    ent (entget(entlast))
 )
 (setvar "cmdecho" 0)
(if (not lyr)  (command "._layer" "_M" "MyImagesLayer"  "_Lt" "Continuous" "MyImagesLayer" ""))

(if (= (cdr (assoc 0 ent)) "image")
    (progn
        (setq ent (subst (cons 8 "MyImagesLayer" ) (assoc 8 ent) ent))
        (setq ent (entmod ent))
    )
)  
(command "._layer" "_s" old "")
(setvar "cmdecho" 1)  
(princ)
)

[dlanorh]

Late to the party.

(defun rh:gbb ( obj / ll ur lst)
  (if (= (type obj) 'ENAME) (setq obj (vlax-ename->vla-object obj)))
  (cond ( (= (type obj) 'VLA-OBJECT)
          (vlax-invoke-method obj 'getboundingbox 'll 'ur)
          (setq lst (mapcar 'vlax-safearray->list (list ll ur)))
        )
  );end_cond
);end_defun

(defun rh:bb_size (lst) (setq lst (mapcar '- (cadr lst) (car lst))))

(defun rh:rect (pt lst / p1 p2 p3 p4)
  (setq p1 pt
        p2 (mapcar '+ p1 (list (car lst) 0.0 0.0))
        p3 (mapcar '+ p2 (list 0.0 (cadr lst) 0.0))
        p4 (mapcar '- p3 (list (car lst) 0.0 0.0))
  );end_setq
  (setq lst (list p1 p2 p3 p4 p1))
);end_defun

(vl-load-com)
;; RJH 28/09/19
;; Move IMage and place on designated layer
(defun c:MIM ( / *error* c_doc c_lyrs ent i_pt obj s_lst cursor flg g_pt p_lst cnt)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
  );end_setq

  (cond ( (not (tblsearch "layer" "MyImagesLayer")) (vla-add c_lyrs "MyImagesLayer")))
  
  (setq ent (car (entsel "\nSelect Image to Drag and Drop : "))
        i_pt (cdr (car (vl-remove-if-not '(lambda (x) (< 9 (car x) 11)) (entget ent))))
        obj (vlax-ename->vla-object ent)
        s_lst (rh:bb_size (rh:gbb obj))
  );end_setq
  
  (prompt "\nSelect New Insertion Point : ")
  (while (and (setq cursor (grread T 13 0)) (not flg))
    (redraw)
    (cond ( (= 5 (car cursor))
            (setq g_pt (cadr cursor)
                  p_lst (rh:rect g_pt s_lst)
                  cnt 0
            );end_setq
            (grdraw i_pt g_pt 1 -1)
            (repeat 4
              (grdraw (nth cnt p_lst) (nth (setq cnt (1+ cnt)) p_lst) 3 1)
            );end_repeat
          )
          ( (= 3 (car cursor)) 
            (setq flg T)
            (vlax-invoke obj 'Move i_pt g_pt)
            (if (/= (vlax-get obj 'layer) "MyImagesLayer") (vlax-put obj 'layer "MyImagesLayer"))
          )
    );end_cond
  );end_while
);end_defun