(defun c:blockhuckepack	(/	      ATT	   DATA
			 DATA_LIST    ENT1_DATA	   ENT1_DATALIST
			 ENT1_NAME    ENT2_DATA	   ENT2_DATALIST
			 ENT2_NAME    ENT_NAME	   OBJ1
			 OBJ2	      SATZ
			)
  (vl-load-com)
  (defun k_satz->entlist (satz)
;;; Elementliste aus Auswahlsatz erstellen
    (if	(= (type satz) 'PICKSET)
      (vl-remove-if-not
	'(lambda (dummy) (= (type dummy) 'ENAME))
	(mapcar 'cadr (ssnamex satz))
      )
    )
  )

  (defun k_->obj_name (name)
;;; VLA-OBJECT zurückgeben
    (cond
      ((= (type name) 'ENAME)
       (vlax-ename->vla-object name)
      )
      ((= (type name) 'VLA-OBJECT)
       name
      )
      ((= (type name) 'STRING)
       (vlax-ename->vla-object (handent name))
      )
      ((= (type name) 'LIST)
       (vlax-ename->vla-object (cdr (assoc -1 name)))
      )
    )
  )

  (defun k_->ent_name (name)
;;; Elementname zurückgeben
    (cond
      ((= (type name) 'ENAME)
       name
      )
      ((= (type name) 'VLA-OBJECT)
       (vlax-vla-object->ename name)
      )
      ((= (type name) 'STRING)
       (handent name)
      )
      ((= (type name) 'LIST)
       (cdr (assoc -1 name))
      )
    )
  )

  (defun k_entlist->satz (ent_list / n satz ent_name)
;;; Auswahlsatz aus Elementliste erstellen
    (if	(listp ent_list)
      (progn
	(setq satz (ssadd))
	(mapcar
	  '(lambda (ent_name)
	     (cond
	       ((= (type ent_name) 'VLA-OBJECT)
		(setq
		  satz (ssadd (vlax-vla-object->ename ent_name) satz)
		)
	       )
	       ((= (type ent_name) 'ename)
		(setq satz (ssadd ent_name satz))
	       )
	       ((= (type ent_name) 'str)
		(if (handent ent_name)
		  (setq satz (ssadd (handent ent_name) satz))
		)
	       )
	     )
	   )
	  ent_list
	)
      )
    )
    satz
  )

  (defun k_get-atts (obj_name)
;;; Attribute als Objektliste zurückgeben
    (if	(and (vlax-property-available-p obj_name "hasattributes")
	     (= (vla-get-hasattributes obj_name) :vlax-true)
	     (not (minusp (vlax-safearray-get-u-bound
			    (vlax-variant-value
			      (vla-getattributes obj_name)
			    )
			    1
			  )
		  )
	     )
	)
      (vlax-invoke
	obj_name
	'GetAttributes
      )
    )
  )

;;; Hauptprogramm
;;; Block anklicken zur Ermittlung des Namens
  (if (setq ent1_name (car (entsel)))
    (if	(= (cdr (assoc 0 (setq ent1_data (entget ent1_name))))
	   "INSERT"
	)
      (progn
;;; Blöcke wählen
	(setq ent1_datalist
			    (mapcar
			      'entget
			      (k_satz->entlist
				(ssget
				  (list '(0 . "INSERT") (assoc 2 ent1_data))
				)
			      )
			    )
;;; Zielblock anklicken
	      ent2_name	    (car (entsel))
	      ent2_datalist
			    (mapcar 'entget
				    (k_satz->entlist
				      (ssget "x"
					     (list '(0 . "INSERT")
						   (assoc 2 (entget ent2_name))
					     )
				      )
				    )
			    )
;;; Abstandsliste erstellen und sortieren
	      data_list
			    (vl-sort
			      (apply
				'append
				(mapcar
				  '(lambda (ent1_data)
				     (mapcar
				       '(lambda	(ent2_data)
					  (list	(distance (cdr (assoc 10 ent1_data))
							  (cdr (assoc 10 ent2_data))
						)
						ent1_data
						ent2_data
					  )
					)
				       ent2_datalist
				     )
				   )
				  ent1_datalist
				)
			      )
			      '(lambda (data1 data2) (< (car data1) (car data2)))
			    )
	)
;;; Datenliste abarbeiten
	(while data_list
	  (setq	data	      (car data_list)
		data_list     (vl-remove-if
				'(lambda (dummy)
				   (or (equal (cadr dummy) (cadr data))
				       (equal (cadr dummy) (caddr data))
				       (equal (caddr dummy) (cadr data))
				       (equal (caddr dummy) (caddr data))
				   )
				 )
				data_list
			      )
		ent1_datalist
			      (vl-remove-if
				'(lambda (dummy)
				   (or (equal dummy (cadr data))
				       (equal dummy (caddr data))
				   )
				 )
				ent1_datalist
			      )
	  )
;;; Einfügepunkt übernehmen
	  (vla-put-insertionpoint
	    (setq obj1 (k_->obj_name (cdr (assoc -1 (cadr data)))))
	    (vla-get-insertionpoint
	      (setq obj2 (k_->obj_name (cdr (assoc -1 (caddr data)))))
	    )
	  )
;;; Attributwert übertragen
	  (vla-put-textstring
	    (cadr
	      (assoc "S_ATT1"
		     (mapcar
		       '(lambda (att) (list (vla-get-TagString att) att))
		       (k_get-atts obj1)
		     )
	      )
	    )
	    (vla-get-TextString
	      (cadr
		(assoc
		  "HOEHE"
		  (mapcar
		    '(lambda (att) (list (vla-get-TagString att) att))
		    (k_get-atts obj2)
		  )
		)
	      )
	    )
	  )
	)
;;; Meldung ausgeben wenn Objekte übrig sind
	(if ent1_datalist
	  (progn
	    (setq satz
		   (k_entlist->satz (mapcar 'k_->ent_name ent1_datalist))
	    )
	    (sssetfirst satz satz)
	    (alert
	      (strcat
		"für "
		(itoa (sslength satz))
		" Objekt(e) keine Ziele gefunden\rObjekte sind markiert"
	      )
	    )
	  )
	)
      )
    )
  )
)