(vl-load-com)
(DEFUN K_->OBJ_NAME (NAME)
  (COND	((= (TYPE NAME) (QUOTE ENAME))
	 (vlax-ename->vla-object NAME)
	)
	((= (TYPE NAME) (QUOTE VLA-OBJECT)) NAME)
	((= (TYPE NAME) (QUOTE STR))
	 (vlax-ename->vla-object (HANDENT NAME))
	)
	((= (TYPE NAME) (QUOTE LIST))
	 (vlax-ename->vla-object (CDR (ASSOC -1 NAME)))
	)
  )
)
(DEFUN K_3D->2D	(WERT / DUMMY)
  (IF (VL-EVERY	(QUOTE (LAMBDA (DUMMY) (= (TYPE DUMMY) (QUOTE LIST))))
		WERT
      )
    (MAPCAR (QUOTE (LAMBDA (DUMMY) (LIST (CAR DUMMY) (CADR DUMMY))))
	    WERT
    )
    (LIST (CAR WERT) (CADR WERT))
  )
)
(DEFUN K_BLK-P->LAYOUT-P (P INSLIST)
  (SETQ P (K_3D->2D P))
  (FOREACH INS INSLIST
    (SETQ ENT_DATA (ENTGET INS))
    (SETQ
      P	(MAPCAR
	  (QUOTE *)
	  P
	  (LIST (CDR (ASSOC 41 ENT_DATA)) (CDR (ASSOC 42 ENT_DATA)))
	)
    )
    (SETQ P (MAPCAR (QUOTE +) P (K_3D->2D (CDR (ASSOC 10 ENT_DATA)))))
    (SETQ P (K_P_TWIST P
		       (CDR (ASSOC 10 ENT_DATA))
		       (CDR (ASSOC 50 ENT_DATA))
	    )
    )
  )
  P
)
(DEFUN K_GET_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)
(DEFUN K_IS (WERT)
  (COND	((= WERT :vlax-false) nil)
	((= WERT :vlax-true) T)
	((= WERT nil) nil)
	((= WERT T) T)
	((= WERT 1) T)
	((= WERT 0) nil)
	((= WERT "1") T)
	((= WERT "0") nil)
	((= WERT "ja") T)
	((= WERT "nein") nil)
  )
)
(DEFUN K_OFANG (MODUS)
  (COND
    ((AND (= MODUS "aus") (= (LOGAND (GETVAR "osmode") 16384) 0))
     (SETVAR "osmode" (+ (GETVAR "osmode") 16384))
    )
    ((AND (= MODUS "ein")
	  (= (LOGAND (GETVAR "osmode") 16384) 16384)
     )
     (SETVAR "osmode" (- (GETVAR "osmode") 16384))
    )
    ((= (TYPE MODUS) (QUOTE INT))
     (IF (MINUSP MODUS)
       (SETVAR "osmode"
	       (K_GET_MERKLISTE (STRCAT "osmode" (ITOA (ABS MODUS))))
       )
       (K_PUT_MERKLISTE
	 (STRCAT "osmode" (ITOA MODUS))
	 (GETVAR "osmode")
       )
     )
    )
    ((= MODUS "mem")
     (K_PUT_MERKLISTE "osmode" (GETVAR "osmode"))
    )
    ((AND (= MODUS "restore") (K_GET_MERKLISTE "osmode"))
     (SETVAR "osmode" (K_GET_MERKLISTE "osmode"))
    )
  )
)
(DEFUN K_PUT_MERKLISTE (NAME WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ K_MERKLISTE
	   (SUBST (LIST NAME WERT)
		  (ASSOC NAME K_MERKLISTE)
		  K_MERKLISTE
	   )
    )
    (SETQ K_MERKLISTE (CONS (LIST NAME WERT) K_MERKLISTE))
  )
  (PRINC)
)
(DEFUN K_P_TWIST (P PX WX)
  (POLAR PX (+ (ANGLE PX P) WX) (DISTANCE PX P))
)
(DEFUN K_SATZ->ENTLIST (SATZ)
  (IF (= (TYPE SATZ) (QUOTE PICKSET))
    (VL-REMOVE-IF-NOT
      (QUOTE (LAMBDA (DUMMY) (= (TYPE DUMMY) (QUOTE ENAME))))
      (MAPCAR (QUOTE CADR) (SSNAMEX SATZ))
    )
  )
)
(DEFUN K_SATZ->OBJLIST (SATZ)
  (MAPCAR (QUOTE vlax-ename->vla-object)
	  (K_SATZ->ENTLIST SATZ)
  )
)
(DEFUN LAYOUT-P->K_BLK-P (P INSLIST)
  (SETQ P (K_3D->2D P))
  (FOREACH INS (REVERSE INSLIST)
    (SETQ ENT_DATA (ENTGET INS))
    (SETQ P (K_P_TWIST P
		       (CDR (ASSOC 10 ENT_DATA))
		       (- 0.0 (CDR (ASSOC 50 ENT_DATA)))
	    )
    )
    (SETQ
      P	(MAPCAR
	  (QUOTE +)
	  (CDR (ASSOC 10 ENT_DATA))
	  (MAPCAR
	    (QUOTE /)
	    (POLAR (QUOTE (0 0))
		   (ANGLE (CDR (ASSOC 10 ENT_DATA)) P)
		   (DISTANCE (CDR (ASSOC 10 ENT_DATA)) P)
	    )
	    (LIST (CDR (ASSOC 41 ENT_DATA)) (CDR (ASSOC 42 ENT_DATA)))
	  )
	)
    )
    (SETQ P (MAPCAR (QUOTE -) P (K_3D->2D (CDR (ASSOC 10 ENT_DATA)))))
  )
  P
)
(defun z001_check_ent
       (pic / ent_name ent_data px p1 p2 p0 point_name w)
  (k_ofang "mem")
  (k_ofang "aus")
  (setq	px	 (nth 1 pic)
	p1	 (osnap (nth 1 (nentselp px)) "_near")
	ent_name (car (nentselp (cadr (grread nil 7 2))))
	ent_data (entget ent_name)
  )
;;; P1 aus ungleichmäßig skalierten Blöcken ermitteln
  (if (and (null p1) (member (cdr (assoc 0 ent_data))
		  '("SPLINE"	 "ELLIPSE"    "ARC"	   "LWPOLYLINE"
		    "LINE"	 "CIRCLE"     "XLINE"	   "RAY"
		   )
	  ))
    (setq p1 (k_blk-p->layout-p
	       (VLAX-CURVE-GETCLOSESTPOINTTO
		 (k_->obj_name ent_name)
		 (layout-p->k_blk-p px (last pic))
	       )
	       (last pic)
	     )
    )
  )
  (setq
    ent_name (car (nentselp (cadr (grread nil 7 2))))
    ent_data (entget ent_name)
  )
  (if (= (cdr (assoc 0 ent_data)) "POINT")
    (progn
      (entdel (setq point_name ent_name))
      (setq px	     (cdr (assoc 10 ent_data))
	    p1	     (osnap (nth 1 (nentselp px)) "_near")
	    ent_name (car (nentselp p1))
	    ent_data (entget ent_name)
      )
      (entdel point_name)
    )
  )
  (cond
    ((and (and (listp (last pic))
	       (vl-every '(lambda (q) (= (type q) 'ENAME)) (last pic))
	  )
	  (member (cdr (assoc 0 ent_data))
		  '("SPLINE"	 "ELLIPSE"    "ARC"	   "LWPOLYLINE"
		    "LINE"	 "CIRCLE"     "XLINE"	   "RAY"
		   )
	  )
	  (setq p2 (layout-p->k_blk-p p1 (last pic)))
	  (VLAX-CURVE-GETPARAMATPOINT (k_->obj_name ent_name) p2)
     )
     (setq w
	    (angle '(0. 0. 0.)
		   (VLAX-CURVE-GETFIRSTDERIV
		     (k_->obj_name ent_name)
		     (VLAX-CURVE-GETPARAMATPOINT (k_->obj_name ent_name) p2)
		   )
	    )
     )
;;; Winkelkorrektur Blockskalierung und Drehung
     (foreach blk (reverse (last pic))
       (setq w (+ (angle '(0 0 0)
			 (mapcar '*
				 (polar '(0 0 0) w 1.0)
				 (list (cdr (assoc 41 (entget blk)))
				       (cdr (assoc 42 (entget blk)))
				       (cdr (assoc 43 (entget blk)))
				 )
			 )
		  )
		  (cdr (assoc 50 (entget blk)))
	       )
       )
     )
     w
    )
    ((and (member (cdr (assoc 0 ent_data))
		  '("SPLINE"	 "ELLIPSE"    "ARC"	   "LWPOLYLINE"
		    "LINE"	 "CIRCLE"     "XLINE"	   "RAY"
		   )
	  )
	  (VLAX-CURVE-GETPARAMATPOINT (k_->obj_name ent_name) p1)
     )
     (setq w
	    (angle '(0. 0. 0.)
		   (VLAX-CURVE-GETFIRSTDERIV
		     (k_->obj_name ent_name)
		     (VLAX-CURVE-GETPARAMATPOINT (k_->obj_name ent_name) p1)
		   )
	    )
     )
    )
    ((member (cdr (assoc 0 ent_data))
	     '("TEXT" "MTEXT" "ATTRIB" "ATTDEF")
     )
     (setq w (cdr (assoc 50 ent_data)))
     (if (and (listp (last pic))
	      (vl-every '(lambda (q) (= (type q) 'ENAME)) (last pic))
	 )
       (foreach	ent (last pic)
	 (if (= (cdr (assoc 0 (entget ent))) "INSERT")
	   (setq w (+ w (cdr (assoc 50 (entget ent)))))
	 )
       )
     )
    )
    (t
     (if (null (setq p0 (osnap px "_cen")))
       (setq p0 (osnap px "_endp"))
     )
     (setq w (angle p0 p1))
    )
  )
  (if (and (>= w (* pi 0.75)) (<= w (* pi 1.75)))
    (setq w (+ w pi))
  )
  (k_ofang "restore")
  w
)

(defun c:k_pic-rotate (/ ATT BLK_ATT OBJ OBJ_LIST PIC PICN W)
  (if (setq pic (nentsel "Objekt zur Fangausrichtung wählen "))
    (progn
      (setq w (z001_check_ent pic))
      (if (setq	pic
		 (entsel
		   "Attribut, Text oder Block wählen oder ENTER zur Mehrfachauswahl : "
		 )
	  )
	(progn
	  (setq picn (nentselp (cadr pic)))
	  (if (= (vla-get-objectname
		   (setq obj (vlax-ename->vla-object (car picn)))
		 )
		 "AcDbAttribute"
	      )
	    (vla-put-rotation obj w)
	    (if
	      (member (vla-get-objectname
			(setq obj (vlax-ename->vla-object (car pic)))
		      )
		      '("AcDbText"
			"AcDbMText"
			"AcDbBlockReference"
		       )
	      )
	       (vla-put-rotation obj w)
	    )
	  )
	)
	(progn
	  (setq	obj_list
		 (k_satz->objlist (ssget '((0 . "TEXT,MTEXT,INSERT"))))
	  )
	  (if
	    (vl-some
	      'k_is
	      (mapcar
		'(lambda (obj)
		   (and	(= (vla-get-objectname obj) "AcDbBlockReference")
			(k_is (vla-get-HasAttributes obj))
		   )
		 )
		obj_list
	      )
	    )
	     (progn
	       (initget "Blöcke Attribute")
	       (setq
		 blk_att (getkword "Blöcke oder Attribute drehen : ")
	       )
	     )
	     (setq blk_att "Blöcke")
	  )
	  (foreach obj obj_list
	    (if	(= (vla-get-objectname obj) "AcDbBlockReference")
	      (if (= blk_att "Attribute")
		(mapcar
		  '(lambda (att) (vla-put-rotation att w))
		  (if
		    (and (vlax-property-available-p obj "hasattributes")
			 (= (vla-get-hasattributes obj) :vlax-true)
			 (not (minusp (vlax-safearray-get-u-bound
					(vlax-variant-value
					  (vla-getattributes obj)
					)
					1
				      )
			      )
			 )
		    )
		     (vlax-invoke obj 'GetAttributes)
		  )
		)
		(vla-put-rotation obj w)
	      )
	      (vla-put-rotation obj w)
	    )
	  )
	)
      )
    )
  )
)