;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_INSIMP                                             - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Bauteillegende erstellen                                       - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_insimp                                                       - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 23.02.2026                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(vl-load-com)
(DEFUN :M-ROUND	(#REAL)
  (COND	((= (QUOTE REAL) (TYPE #REAL))
	 (IF (<= 0.5 (ABS (REM #REAL 1)))
	   (IF (> #REAL 0)
	     (1+ (FIX #REAL))
	     (1- (FIX #REAL))
	   )
	   (FIX #REAL)
	 )
	)
	(#REAL)
  )
)
(DEFUN :M-ROUNDTOEVEN (#NUMLST)
  (MAPCAR (QUOTE (LAMBDA (N)
		   (IF (/= (REM N 1) 0.5)
		     (:M-ROUND N)
		     (PROGN (IF	(> N 0)
			      (* 2 (:M-ROUND (/ N 2)))
			      (* 2 (:M-ROUND (/ N 2)) -1)
			    )
		     )
		   )
		 )
	  )
	  #NUMLST
  )
)
(DEFUN COMPARE (E0 E1 /)
  (COND	((> (CAR E0) (CAR E1)) 1)
	((< (CAR E0) (CAR E1)) -1)
	((QUOTE T) 0)
  )
)
(DEFUN GATHER (LST LEN)
  (COND	((NULL LST) nil)
	((> (LENGTH LST) LEN)
	 (CONS (N-CAR LEN LST) (GATHER (N-CDR LEN LST) LEN))
	)
	((QUOTE SONST) (LIST LST))
  )
)
(DEFUN I-CDR (LST) (REVERSE (CDR (REVERSE LST))))
(DEFUN K_->ENT_NAME (NAME)
  (COND	((= (TYPE NAME) (QUOTE ENAME)) NAME)
	((= (TYPE NAME) (QUOTE VLA-OBJECT))
	 (vlax-vla-object->ename NAME)
	)
	((= (TYPE NAME) (QUOTE STR)) (HANDENT NAME))
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC -1 NAME))
	 (CDR (ASSOC -1 NAME))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC 5 NAME))
	 (HANDENT (CDR (ASSOC 5 NAME)))
	)
  )
)
(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))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC -1 NAME))
	 (vlax-ename->vla-object (CDR (ASSOC -1 NAME)))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC 5 NAME))
	 (vlax-ename->vla-object (HANDENT (CDR (ASSOC 5 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_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(DEFUN K_AUSWAHL_LISTE_SORT (LISTE	     /
			     $REASON	     AUSWAHL_LISTE_ID
			     DUMMY_LIST	     LISTE_FILTER
			     LISTE_SORT	     LISTE_WAHL
			     OK_AUSWAHL_LISTE
			     TXT	     ZEIG_LISTE
			     ZEIG_LISTE_SORT
			    )
  (DEFUN END_AUSWAHL_LISTE (WERT)
    (SETQ OK_AUSWAHL_LISTE WERT)
    (DONE_DIALOG)
  )
  (DEFUN AUSWAHL_LISTE_IN nil
    (IF	LISTE_FILTER
      (SETQ LISTE_SORT
	     (REVERSE
	       (CONS (NTH (SETQ POS (ATOI (GET_TILE "liste")))
			  LISTE_FILTER
		     )
		     (REVERSE LISTE_SORT)
	       )
	     )
      )
    )
    (AUSWAHL_LISTE_SLISTE_SORT)
    (AUSWAHL_LISTE_SLISTE)
    (SETQ POS (MIN POS (1- (LENGTH LISTE_FILTER))))
    (SET_TILE "liste" (ITOA POS))
  )
  (DEFUN AUSWAHL_LISTE_OUT nil
    (IF	LISTE_SORT
      (SETQ LISTE_SORT
	     (VL-REMOVE
	       (NTH (SETQ POS (ATOI (GET_TILE "liste_sort")))
		    LISTE_SORT
	       )
	       LISTE_SORT
	     )
      )
    )
    (AUSWAHL_LISTE_SLISTE_SORT)
    (AUSWAHL_LISTE_SLISTE)
    (SETQ POS (MIN POS (1- (LENGTH LISTE_SORT))))
    (SET_TILE "liste_sort" (ITOA POS))
  )
  (DEFUN AUSWAHL_LISTE_OBEN nil
    (IF	LISTE_SORT
      (PROGN (SETQ POS (ATOI (GET_TILE "liste_sort")))
	     (IF (> POS 0)
	       (PROGN (SETQ LISTE_SORT
			     (MAPCAR
			       (QUOTE (LAMBDA (N) (NTH N LISTE_SORT)))
			       (APPEND (K_ZAHLENREIHE (1- POS))
				       (LIST POS (1- POS))
				       (K_ZAHLENREIHE_START
					 (- (LENGTH LISTE_SORT) (1+ POS))
					 (1+ POS)
				       )
			       )
			     )
		      )
		      (AUSWAHL_LISTE_SLISTE_SORT)
		      (SET_TILE "liste_sort" (ITOA (1- POS)))
	       )
	     )
      )
    )
  )
  (DEFUN AUSWAHL_LISTE_UNTEN nil
    (IF	LISTE_SORT
      (PROGN (SETQ POS (ATOI (GET_TILE "liste_sort")))
	     (IF (< POS (1- (LENGTH LISTE_SORT)))
	       (PROGN (SETQ LISTE_SORT
			     (MAPCAR
			       (QUOTE (LAMBDA (N) (NTH N LISTE_SORT)))
			       (APPEND (K_ZAHLENREIHE POS)
				       (LIST (1+ POS) POS)
				       (K_ZAHLENREIHE_START
					 (- (LENGTH LISTE_SORT) (+ POS 2))
					 (+ POS 2)
				       )
			       )
			     )
		      )
		      (AUSWAHL_LISTE_SLISTE_SORT)
		      (SET_TILE "liste_sort" (ITOA (1+ POS)))
	       )
	     )
      )
    )
  )
  (DEFUN AUSWAHL_LISTE_LISTE nil
    (IF	(= $REASON 4)
      (AUSWAHL_LISTE_IN)
    )
  )
  (DEFUN AUSWAHL_LISTE_LISTE_SORT nil
    (IF	(= $REASON 4)
      (AUSWAHL_LISTE_OUT)
    )
  )
  (DEFUN AUSWAHL_LISTE_SLISTE nil
    (SETQ LISTE_WAHL LISTE)
    (SETQ NICHT (STRCASE (GET_TILE "nicht")))
    (SETQ LISTE_FILTER
	   (VL-REMOVE-IF
	     (QUOTE
	       (LAMBDA (WAHL) (WCMATCH (STRCASE WAHL) NICHT))
	     )
	     LISTE_WAHL
	   )
    )
    (FOREACH WAHL LISTE_SORT
      (SETQ LISTE_FILTER (VL-REMOVE WAHL LISTE_FILTER))
    )
    (SETQ ZEIG_LISTE
	   (MAPCAR
	     (QUOTE
	       (LAMBDA (TXT)
		 (SUBSTR TXT (1+ (ATOI (GET_TILE "slide_liste"))))
	       )
	     )
	     LISTE_FILTER
	   )
    )
    (START_LIST "liste")
    (MAPCAR (QUOTE ADD_LIST) ZEIG_LISTE)
    (END_LIST)
  )
  (DEFUN AUSWAHL_LISTE_SLISTE_SORT nil
    (SETQ ZEIG_LISTE_SORT
	   (MAPCAR
	     (QUOTE
	       (LAMBDA (TXT)
		 (SUBSTR
		   TXT
		   (1+ (ATOI (GET_TILE "slide_liste_sort")))
		 )
	       )
	     )
	     LISTE_SORT
	   )
    )
    (START_LIST "liste_sort")
    (MAPCAR (QUOTE ADD_LIST) ZEIG_LISTE_SORT)
    (END_LIST)
  )
  (SETQ AUSWAHL_LISTE_ID (LOAD_DIALOG "k_insimp.dcl"))
  (IF (NOT (NEW_DIALOG "k_auswahl_liste_sort" AUSWAHL_LISTE_ID))
    (EXIT)
  )
  (K_DRAW_IMAGE
    "out"
    (LIST (QUOTE ("fill" ("color" 255)))
	  (QUOTE ("arrow" ("start" (95 50))
			  ("end" (5 50))
			  ("color" 0)
			  ("size" 7)
			  ("ratio" 0.5)
			  ("fillcolor" 3)
		 )
	  )
    )
  )
  (K_DRAW_IMAGE
    "in"
    (LIST (QUOTE ("fill" ("color" 255)))
	  (QUOTE ("arrow" ("start" (5 50))
			  ("end" (95 50))
			  ("color" 0)
			  ("size" 7)
			  ("ratio" 0.5)
			  ("fillcolor" 3)
		 )
	  )
    )
  )
  (K_DRAW_IMAGE
    "oben"
    (LIST (QUOTE ("fill" ("color" 255)))
	  (QUOTE ("arrow" ("start" (50 95))
			  ("end" (50 5))
			  ("color" 0)
			  ("size" 4)
			  ("ratio" 1.5)
			  ("fillcolor" 3)
		 )
	  )
    )
  )
  (K_DRAW_IMAGE
    "unten"
    (LIST (QUOTE ("fill" ("color" 255)))
	  (QUOTE ("arrow" ("start" (50 5))
			  ("end" (50 95))
			  ("color" 0)
			  ("size" 4)
			  ("ratio" 1.5)
			  ("fillcolor" 3)
		 )
	  )
    )
  )
  (AUSWAHL_LISTE_SLISTE)
  (START_LIST "liste_sort")
  (MAPCAR (QUOTE ADD_LIST) LISTE_SORT)
  (END_LIST)
  (ACTION_TILE "accept" "(end_auswahl_liste 1)")
  (ACTION_TILE "cancel" "(end_auswahl_liste 0)")
  (ACTION_TILE "in" "(auswahl_liste_in)")
  (ACTION_TILE "out" "(auswahl_liste_out)")
  (ACTION_TILE "oben" "(auswahl_liste_oben)")
  (ACTION_TILE "unten" "(auswahl_liste_unten)")
  (ACTION_TILE "nicht" "(auswahl_liste_sliste)")
  (ACTION_TILE "liste" "(auswahl_liste_liste)")
  (ACTION_TILE "liste_sort" "(auswahl_liste_liste_sort)")
  (ACTION_TILE "slide_liste" "(auswahl_liste_sliste)")
  (ACTION_TILE
    "slide_liste_sort"
    "(auswahl_liste_sliste_sort)"
  )
  (START_DIALOG)
  (UNLOAD_DIALOG AUSWAHL_LISTE_ID)
  (SETQ DUMMY_LIST (LIST))
  (IF (= OK_AUSWAHL_LISTE 1)
    LISTE_SORT
    nil
  )
)
(DEFUN K_COLLECTION->LIST (COLLECTION / LISTE)
  (COND	((MEMBER "VLA-COLLECTION->LIST" (ATOMS-FAMILY 1))
	 (SETQ LISTE (VLA-COLLECTION->LIST COLLECTION))
	)
	((MEMBER "VLAX-FOR" (ATOMS-FAMILY 1))
	 (SETQ LISTE (LIST))
	 (VLAX-FOR DUMMY COLLECTION (SETQ LISTE (CONS DUMMY LISTE)))
	 (REVERSE LISTE)
	)
  )
  LISTE
)
(DEFUN K_COUNTER_DIALOG	(TODO TXT1 TXT2)
  (DEFUN K_COUNTER_DIALOG_NEU nil
    (DONE_DIALOG)
    (NEW_DIALOG "k_counter_dialog" K_COUNTER_DLG)
    (SETQ K_COUNTER_DIALOG_N 0)
  )
  (COND	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "START"))
	 (SETQ K_COUNTER_DLG
		(LOAD_DIALOG "k_insimp.dcl")
	       K_COUNTER_DIALOG_N 0
	       K_COUNTER_DIALOG_TITEL TXT1
	 )
	 (COND ((AND TXT2 (= (TYPE TXT1) (QUOTE INT)))
		(SETQ K_COUNTER_DIALOG_X TXT2)
	       )
	       ((AND TXT2 (= (TYPE TXT1) (QUOTE STR)))
		(SETQ K_COUNTER_DIALOG_T TXT2)
	       )
	       (T (SETQ K_COUNTER_DIALOG_X nil))
	 )
	 (IF (NOT (NEW_DIALOG "k_counter_dialog" K_COUNTER_DLG))
	   (EXIT)
	 )
	 (IF K_COUNTER_DIALOG_TITEL
	   (SET_TILE "titel"
		     (VL-PRINC-TO-STRING K_COUNTER_DIALOG_TITEL)
	   )
	 )
	)
	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "END"))
	 (DONE_DIALOG)
	 (IF K_COUNTER_DLG
	   (UNLOAD_DIALOG K_COUNTER_DLG)
	 )
	 (SETQ K_COUNTER_DIALOG_N nil
	       K_COUNTER_DLG nil
	 )
	)
	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "SHOW"))
	 (SETQ K_COUNTER_DIALOG_N (1+ K_COUNTER_DIALOG_N))
	 (IF (AND K_COUNTER_DIALOG_X
		  (>= K_COUNTER_DIALOG_N K_COUNTER_DIALOG_X)
	     )
	   (K_COUNTER_DIALOG_NEU)
	 )
	 (SET_TILE "text1" (VL-PRINC-TO-STRING TXT1))
	 (SET_TILE "text2" (VL-PRINC-TO-STRING TXT2))
	)
	(T nil)
  )
)
(DEFUN K_COUNTER_LISTE (TODO TXT1 TXT2 LISTE / K_COUNTER_LISTE_DCL)
  (DEFUN K_COUNTER_LISTE_NEU nil
    (DONE_DIALOG)
    (NEW_DIALOG "k_counter_liste" K_COUNTER_LISTE_ID)
    (SETQ K_COUNTER_DIALOG_N 0)
  )
  (COND	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "START"))
	 (SETQ
	   W (IF LISTE
	       (APPLY (QUOTE MAX)
		      (MAPCAR (QUOTE STRLEN)
			      (MAPCAR (QUOTE VL-PRINC-TO-STRING) LISTE)
		      )
	       )
	       150
	     )
	 )
	 (SETQ W (MIN (MAX W 50) 150))
	 (SETQ H (IF LISTE
		   (FIX (LENGTH LISTE))
		   40
		 )
	 )
	 (SETQ H (MIN (MAX H 10) 40))
	 (SETQ K_COUNTER_LISTE_DCL
		(K_TEMP-DCL
		  (LIST	"k_counter_liste : dialog {"
			"  key = \"titel\";"
			(STRCAT "width = " (ITOA W) ";")
			"  : text {"
			"      key = \"text1\";"
			"      label = \"\";"
			"  }"
			"  : text {"
			"      key = \"text2\";"
			"      label = \"\";"
			"  }"
			"  : list_box {"
			"      key = \"liste\";"
			"      label = \"\";"
			(STRCAT "height = " (ITOA H) ";")
			"  }"
			"  : image_button {"
			"    key = \"accept\";"
			"    is_default = true;"
			"  }"
			"}"
		  )
		)
	 )
	 (SETQ K_COUNTER_LISTE_ID (LOAD_DIALOG K_COUNTER_LISTE_DCL))
	 (VL-FILE-DELETE K_COUNTER_LISTE_DCL)
	 (SETQ K_COUNTER_LISTE_N 0)
	 (COND ((AND TXT1 (= (TYPE TXT1) (QUOTE INT)))
		(SETQ K_COUNTER_LISTE_X TXT1)
	       )
	       ((AND TXT1 (= (TYPE TXT1) (QUOTE STR)))
		(SETQ K_COUNTER_LISTE_T TXT1)
	       )
	       (T (SETQ K_COUNTER_LISTE_X nil))
	 )
	 (IF (NOT (NEW_DIALOG "k_counter_liste" K_COUNTER_LISTE_ID))
	   (EXIT)
	 )
	 (IF TXT1
	   (SET_TILE "titel" (VL-PRINC-TO-STRING TXT1))
	 )
	)
	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "END"))
	 (DONE_DIALOG)
	 (IF K_COUNTER_DLG
	   (UNLOAD_DIALOG K_COUNTER_DLG)
	 )
	 (SETQ K_COUNTER_LISTE_N nil
	       K_COUNTER_DLG nil
	 )
	)
	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "SHOW"))
	 (SETQ K_COUNTER_LISTE_N (1+ K_COUNTER_LISTE_N))
	 (IF (AND K_COUNTER_LISTE_X
		  (>= K_COUNTER_LISTE_N K_COUNTER_LISTE_X)
	     )
	   (K_COUNTER_LISTE_NEU)
	 )
	 (SET_TILE "text1" (VL-PRINC-TO-STRING TXT1))
	 (SET_TILE "text2" (VL-PRINC-TO-STRING TXT2))
	 (START_LIST "liste")
	 (MAPCAR (QUOTE ADD_LIST)
		 (MAPCAR (QUOTE VL-PRINC-TO-STRING) LISTE)
	 )
	 (END_LIST)
	)
	(T nil)
  )
)
(DEFUN K_CUT_PFADLAST (PFAD / PFAD_LIST DUMMY_LIST)
  (WHILE (NOT
	   (EQUAL PFAD (SETQ DUMMY (VL-STRING-SUBST "/" "\\" PFAD)))
	 )
    (SETQ PFAD DUMMY)
  )
  (SETQ	PFAD_LIST
	 (REVERSE
	   (CDR
	     (REVERSE (VL-REMOVE "" (K_ZERLEGE_ART PFAD "/" "STR"))
	     )
	   )
	 )
  )
  (SETQ PFAD "")
  (FOREACH DUMMY PFAD_LIST
    (SETQ PFAD (STRCAT PFAD DUMMY "/"))
  )
  (IF (= PFAD "")
    (PROGN (FOREACH DUMMY DUMMY_LIST
	     (SETQ PFAD (STRCAT PFAD DUMMY "/"))
	   )
    )
  )
  (SETQ PFAD PFAD)
)
(DEFUN K_DATA->PROP (PROP DATA)
  (SETQ DATA (VL-PRINC-TO-STRING DATA))
  (COND	((= (vlax-variant-type (vla-get-Value PROP)) 5)
	 (vla-put-Value
	   PROP
	   (vlax-make-variant
	     (ATOF DATA)
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
	((= (vlax-variant-type (vla-get-Value PROP)) 4)
	 (vla-put-Value
	   PROP
	   (vlax-make-variant
	     (ATOF DATA)
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
	((= (vlax-variant-type (vla-get-Value PROP)) 2)
	 (IF (NOT (MINUSP (ATOI DATA)))
	   (vla-put-Value
	     PROP
	     (vlax-make-variant
	       (ATOI DATA)
	       (vlax-variant-type (vla-get-Value PROP))
	     )
	   )
	 )
	)
	((= (vlax-variant-type (vla-get-Value PROP)) 3)
	 (vla-put-Value
	   PROP
	   (vlax-make-variant
	     (ATOI DATA)
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
	((= (vlax-variant-type (vla-get-Value PROP)) 8)
	 (vla-put-Value
	   PROP
	   (vlax-make-variant
	     (ATOI DATA)
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
	((vla-put-Value
	   PROP
	   (vlax-make-variant
	     DATA
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
  )
)
(DEFUN K_DATA->PROPERTY-CONVERT	(OBJ_NAME BEZ DATA / PROP_TYPE)
  (SETQ PROP_TYPE (TYPE (K_GET_DATA OBJ_NAME BEZ nil nil)))
  (IF (= PROP_TYPE (TYPE DATA))
    DATA
    (COND ((= PROP_TYPE (QUOTE INT)) (ATOI (VL-PRINC-TO-STRING DATA)))
	  ((= PROP_TYPE (QUOTE REAL))
	   (ATOF (VL-PRINC-TO-STRING DATA))
	  )
	  ((= PROP_TYPE (QUOTE STR)) (VL-PRINC-TO-STRING DATA))
	  ((= PROP_TYPE (QUOTE LIST))
	   (IF (= (TYPE (READ DATA)) (QUOTE LIST))
	     (READ DATA)
	   )
	  )
    )
  )
)
(DEFUN K_DEL-NTH (LISTE N / DUMMY_LIST)
  (REPEAT N
    (SETQ DUMMY_LIST (CONS (CAR LISTE) DUMMY_LIST)
	  LISTE	     (CDR LISTE)
    )
  )
  (APPEND (REVERSE DUMMY_LIST) (CDR LISTE))
)
(DEFUN K_DRAW_IMAGE (IMAGE_NAME	       DATA_LIST	 /
		     ART      B	       BREITE	C	 CENTER
		     CHR_LIST COLOR    C_LIST	DATA	 DUMMY
		     DUMMY_LIST	       DX	DY	 END
		     FILLCOLOR	       FONT_LIST	 H
		     HEIGHT   HOEHE    MAX-X	MAX-Y	 MIN-X
		     MIN-Y    P	       P1	P2	 P3
		     P4	      PL       PLIST	POS	 POSITION
		     P_LIST   RADIUS   RATIO	RICHTUNG SIZE
		     START    TEMP_LIST		TEXT	 W
		     WIDTH    WINKEL   W_LIST	X-LIST	 Y-LIST
		     Z
		    )
  (SETQ	FONT_LIST
	 (QUOTE
	   ((" " ((1 0.0 0.0) (2 0.5 0.0)))
	     ("³" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.33 0.0)
		    (1 0.5 0.17)
		    (1 0.5 0.33)
		    (1 0.33 0.5)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.33 0.83)
		    (1 0.33 1.0)
		    (2 0.6 0.0)
		  )
	     )
	     ("²" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.33 0.0)
		    (1 0.5 0.17)
		    (1 0.5 0.33)
		    (1 0.33 0.5)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.33 0.83)
		    (1 0.33 1.0)
		    (2 0.6 0.0)
		  )
	     )
	     ("]" ((1 0.0 0.0)
		    (1 0.33 0.0)
		    (1 0.33 1.0)
		    (1 0.0 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("[" ((1 0.33 1.0)
		    (1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.33 0.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("}" ((1 0.0 1.0)
		    (1 0.17 0.83)
		    (1 0.17 0.67)
		    (1 0.33 0.5)
		    (1 0.17 0.33)
		    (1 0.17 0.17)
		    (1 0.0 0.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("{" ((1 0.33 0.0)
		    (1 0.17 0.17)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.17 0.67)
		    (1 0.17 0.83)
		    (1 0.33 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("°" ((1 0.17 0.0)
		    (1 0.33 0.17)
		    (1 0.17 0.33)
		    (1 0.0 0.17)
		    (2 0.43 0.0)
		  )
	     )
	     ("^" ((1 0.0 0.33)
		    (1 0.33 0.0)
		    (1 0.67 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("+" ((1 0.33 0.83)
		    (1 0.33 0.17)
		    (0 0 0)
		    (1 0.67 0.5)
		    (1 0.0 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("*" ((1 0.33 0.83)
		    (1 0.33 0.17)
		    (0 0 0)
		    (1 0.67 0.5)
		    (1 0.0 0.5)
		    (0 0 0)
		    (1 0.67 0.17)
		    (1 0.0 0.83)
		    (0 0 0)
		    (1 0.0 0.17)
		    (1 0.67 0.83)
		    (2 0.77 0.0)
		  )
	     )
	     ("#" ((1 0.0 0.67)
		    (1 0.67 0.67)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (0 0 0)
		    (1 0.5 1.0)
		    (1 0.5 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("'" ((1 0.0 0.33) (1 0.17 0.0) (2 0.27 0.0)))
	     (">" ((1 0.0 0.0) (1 0.5 0.5) (1 0.0 1.0) (2 0.6 0.0))
	     )
	     ("<" ((1 0.5 0.0) (1 0.0 0.5) (1 0.5 1.0) (2 0.6 0.0))
	     )
	     ("_" ((1 0.0 1.17) (1 0.67 1.17) (2 0.77 0.0)))
	     (":" ((1 0.0 0.33)
		    (1 0.0 0.5)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.0 0.83)
		    (2 0.1 0.0)
		  )
	     )
	     (";" ((1 0.17 0.33)
		    (1 0.17 0.5)
		    (0 0 0)
		    (1 0.17 0.67)
		    (1 0.17 1.0)
		    (1 0.0 1.17)
		    (2 0.27 0.0)
		  )
	     )
	     ("-" ((1 0.0 0.5) (1 0.67 0.5) (2 0.77 0.0)))
	     ("." ((1 0.0 1.0) (1 0.0 0.83) (2 0.1 0.0)))
	     ("," ((1 0.17 0.83)
		    (1 0.17 1.0)
		    (1 0.0 1.17)
		    (2 0.27 0.0)
		  )
	     )
	     ("?" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.33 0.0)
		    (1 0.5 0.17)
		    (1 0.5 0.33)
		    (1 0.33 0.5)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.33 0.83)
		    (1 0.33 1.0)
		    (2 0.6 0.0)
		  )
	     )
	     ("=" ((1 0.0 0.33)
		    (1 0.67 0.33)
		    (0 0 0)
		    (1 0.67 0.67)
		    (1 0.0 0.67)
		    (2 0.77 0.0)
		  )
	     )
	     (")" ((1 0.0 0.0)
		    (1 0.33 0.33)
		    (1 0.33 0.67)
		    (1 0.0 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("(" ((1 0.33 0.0)
		    (1 0.0 0.33)
		    (1 0.0 0.67)
		    (1 0.33 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("/" ((1 0.0 1.0) (1 0.67 0.0) (2 0.77 0.0)))
	     ("&" ((1 0.67 0.67)
		    (1 0.33 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (1 0.33 0.17)
		    (1 0.17 0.0)
		    (1 0.0 0.17)
		    (1 0.0 0.33)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("%" ((1 0.0 0.17)
		    (1 0.17 0.17)
		    (1 0.17 0.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.0 1.0)
		    (0 0 0)
		    (1 0.5 1.0)
		    (1 0.5 0.83)
		    (1 0.67 0.83)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("$" ((1 0.0 0.83)
		    (1 0.5 0.83)
		    (1 0.67 0.67)
		    (1 0.5 0.5)
		    (1 0.17 0.5)
		    (1 0.0 0.33)
		    (1 0.17 0.17)
		    (1 0.67 0.17)
		    (0 0 0)
		    (1 0.33 0.0)
		    (1 0.33 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("§" ((1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.5 0.83)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.33 0.0)
		    (1 0.17 0.0)
		    (1 0.0 0.17)
		    (1 0.17 0.33)
		    (1 0.33 0.33)
		    (1 0.5 0.5)
		    (1 0.33 0.67)
		    (1 0.17 0.67)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (2 0.6 0.0)
		  )
	     )
	     ("\"" ((1 0.0 0.33)
		     (1 0.17 0.0)
		     (0 0 0)
		     (1 0.33 0.0)
		     (1 0.17 0.33)
		     (2 0.43 0.0)
		   )
	     )
	     ("!" ((1 0.0 1.0)
		    (1 0.0 0.83)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.0 0.0)
		    (2 0.1 0.0)
		  )
	     )
	     ("ß" ((1 0.0 1.0)
		    (1 0.17 0.83)
		    (1 0.17 0.17)
		    (1 0.33 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.67 0.67)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.33 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("Ü" ((1 0.0 0.0)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.5 0.0)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 0.17)
		    (2 0.77 0.0)
		  )
	     )
	     ("Ö" ((1 0.17 0.17)
		    (1 0.17 0.0)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.5 0.0)
		    (0 0 0)
		    (1 0.0 0.2)
		    (1 0.67 0.2)
		    (1 0.67 1.0)
		    (1 0.0 1.0)
		    (1 0.0 0.2)
		    (2 0.77 0.0)
		  )
	     )
	     ("Ä" ((1 0.0 1.0)
		    (1 0.0 0.67)
		    (0 0 0)
		    (1 0.0 0.17)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.67 0.17)
		    (0 0 0)
		    (1 0.67 0.67)
		    (1 0.33 0.0)
		    (1 0.0 0.67)
		    (1 0.67 0.67)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("ü" ((1 0.17 0.0)
		    (1 0.17 0.17)
		    (0 0 0)
		    (1 0.0 0.33)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.67 0.67)
		    (0 0 0)
		    (1 0.5 0.0)
		    (1 0.5 0.17)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("ö" ((1 0.0 0.0)
		    (1 0.0 0.17)
		    (0 0 0)
		    (1 0.67 0.17)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("ä" ((1 0.0 0.0)
		    (1 0.0 0.17)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.5 0.0)
		    (0 0 0)
		    (1 0.5 0.83)
		    (1 0.5 0.5)
		    (1 0.33 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.5 0.83)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("Z" ((1 0.0 0.0)
		    (1 0.67 0.0)
		    (1 0.0 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("Y" ((1 0.0 0.0)
		    (1 0.33 0.5)
		    (0 0 0)
		    (1 0.33 1.0)
		    (1 0.33 0.5)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("X" ((1 0.0 1.0)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.0 0.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("W" ((1 0.0 0.0)
		    (1 0.33 1.0)
		    (1 0.5 0.5)
		    (1 0.67 1.0)
		    (1 1.0 0.0)
		    (2 1.1 0.0)
		  )
	     )
	     ("V" ((1 0.0 0.0) (1 0.5 1.0) (1 1.0 0.0) (2 1.1 0.0))
	     )
	     ("U" ((1 0.0 0.0)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("T" ((1 0.0 0.0)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.33 0.0)
		    (1 0.33 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("S" ((1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (2 0.77 0.0)
		  )
	     )
	     ("R" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.0 0.5)
		    (0 0 0)
		    (1 0.17 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("Q" ((1 0.33 0.67)
		    (1 0.5 0.83)
		    (1 0.33 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.67)
		    (1 0.5 0.83)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("P" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.0 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("O" ((1 0.0 0.0)
		    (1 0.67 0.0)
		    (1 0.67 1.0)
		    (1 0.0 1.0)
		    (1 0.0 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("N" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.67 1.0)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("M" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.33 0.67)
		    (1 0.67 0.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("L"
	       ((1 0.0 0.0) (1 0.0 1.0) (1 0.67 1.0) (2 0.77 0.0))
	     )
	     ("K" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.17 0.5)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.17 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("J" ((1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("I" ((1 0.0 0.0)
		    (1 0.33 0.0)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (0 0 0)
		    (1 0.0 1.0)
		    (1 0.33 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("H" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.67 0.5)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("G" ((1 0.5 0.5)
		    (1 0.67 0.5)
		    (1 0.67 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("F" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.33 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("E" ((1 0.0 0.5)
		    (1 0.33 0.5)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.0 0.0)
		    (1 0.0 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("D" ((1 0.0 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.17)
		    (1 0.5 0.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("C" ((1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (2 0.77 0.0)
		  )
	     )
	     ("B" ((1 0.0 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.67)
		    (1 0.5 0.5)
		    (0 0 0)
		    (1 0.17 0.5)
		    (1 0.5 0.5)
		    (1 0.67 0.33)
		    (1 0.67 0.17)
		    (1 0.5 0.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("A" ((1 0.0 1.0)
		    (1 0.0 0.67)
		    (0 0 0)
		    (1 0.67 0.67)
		    (1 0.33 0.0)
		    (1 0.0 0.67)
		    (1 0.67 0.67)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("z" ((1 0.0 0.33)
		    (1 0.67 0.33)
		    (1 0.0 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("y" ((1 0.0 0.33)
		    (1 0.33 1.0)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.17 1.33)
		    (1 0.0 1.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("x" ((1 0.0 1.0)
		    (1 0.67 0.33)
		    (0 0 0)
		    (1 0.0 0.33)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("w" ((1 0.0 0.33)
		    (1 0.17 1.0)
		    (1 0.33 0.33)
		    (1 0.5 1.0)
		    (1 0.67 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("v" ((1 0.0 0.33)
		    (1 0.33 1.0)
		    (1 0.67 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("u" ((1 0.0 0.33)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.67 0.67)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("t" ((1 0.0 0.33)
		    (1 0.67 0.33)
		    (0 0 0)
		    (1 0.33 0.0)
		    (1 0.33 0.83)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (2 0.77 0.0)
		  )
	     )
	     ("s" ((1 0.0 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.5 0.67)
		    (1 0.17 0.67)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.67 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("r" ((1 0.0 1.0)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("q" ((1 0.67 1.33)
		    (1 0.67 0.33)
		    (0 0 0)
		    (1 0.67 0.5)
		    (1 0.5 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("p" ((1 0.0 1.33)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.0 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("o" ((1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("n" ((1 0.0 1.0)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("m" ((1 0.0 1.0)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.33 0.5)
		    (0 0 0)
		    (1 0.33 0.67)
		    (1 0.33 0.5)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("l"
	       ((1 0.0 0.0) (1 0.0 0.83) (1 0.17 1.0) (2 0.27 0.0))
	     )
	     ("k" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.33 0.67)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("j" ((1 0.0 1.17)
		    (1 0.17 1.33)
		    (1 0.33 1.33)
		    (1 0.5 1.17)
		    (1 0.5 0.33)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.5 0.0)
		    (2 0.6 0.0)
		  )
	     )
	     ("i" ((1 0.0 1.0)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.17)
		    (1 0.0 0.0)
		    (2 0.1 0.0)
		  )
	     )
	     ("h" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("g" ((1 0.0 1.17)
		    (1 0.17 1.33)
		    (1 0.5 1.33)
		    (1 0.67 1.17)
		    (1 0.67 0.5)
		    (1 0.5 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("f" ((1 0.0 0.5)
		    (1 0.5 0.5)
		    (0 0 0)
		    (1 0.67 0.17)
		    (1 0.5 0.0)
		    (1 0.33 0.0)
		    (1 0.17 0.17)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("e" ((1 0.0 0.67)
		    (1 0.5 0.67)
		    (1 0.67 0.5)
		    (1 0.5 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("d" ((1 0.33 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.33 0.33)
		    (1 0.67 0.67)
		    (1 0.33 1.0)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("c" ((1 0.67 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("b" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.33 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.33 1.0)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("a" ((1 0.5 0.83)
		    (1 0.5 0.5)
		    (1 0.33 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.5 0.83)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("9" ((1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.67 0.67)
		    (1 0.67 0.17)
		    (1 0.5 0.0)
		    (1 0.17 0.0)
		    (1 0.0 0.17)
		    (1 0.0 0.33)
		    (1 0.17 0.5)
		    (1 0.67 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("8" ((1 0.17 0.5)
		    (1 0.5 0.5)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.67 0.67)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.67)
		    (1 0.17 0.5)
		    (1 0.0 0.33)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("7"
	       ((1 0.0 0.0) (1 0.67 0.0) (1 0.17 1.0) (2 0.77 0.0))
	     )
	     ("6" ((1 0.0 0.5)
		    (1 0.5 0.5)
		    (1 0.67 0.67)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.33)
		    (1 0.33 0.0)
		    (1 0.5 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("5" ((1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.5)
		    (1 0.5 0.33)
		    (1 0.0 0.33)
		    (1 0.0 0.0)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("4" ((1 0.67 0.67)
		    (1 0.0 0.67)
		    (1 0.5 0.0)
		    (1 0.5 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("3" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (0 0 0)
		    (1 0.33 0.5)
		    (1 0.5 0.5)
		    (1 0.67 0.67)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (2 0.77 0.0)
		  )
	     )
	     ("2" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.17 0.5)
		    (1 0.0 0.67)
		    (1 0.0 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("1" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (0 0 0)
		    (1 0.0 1.0)
		    (1 0.33 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("0" ((1 0.0 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.33 0.0)
		    (1 0.5 0.17)
		    (1 0.5 0.83)
		    (1 0.33 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (2 0.6 0.0)
		  )
	     )
	   )
	 )
  )
  (SETQ ZEICHEN (NTH 0 FONT_LIST))
  (SETQ DATA (CADR ZEICHEN))
  (SETQ PUNKT (NTH 0 DATA))
  (SETQ	FONT_LIST
	 (MAPCAR
	   (QUOTE
	     (LAMBDA (ZEICHEN)
	       (SETQ DATA (CADR ZEICHEN))
	       (LIST (CAR ZEICHEN)
		     (APPLY
		       (QUOTE APPEND)
		       (MAPCAR
			 (QUOTE
			   (LAMBDA (PUNKT)
			     (IF (= (CAR PUNKT) 1)
			       (PROGN (SETQ DUMMY (LIST PUNKT))
				      (SETQ ALT_PUNKT PUNKT)
			       )
			       (PROGN
				 (SETQ DUMMY (LIST ALT_PUNKT PUNKT))
				 (SETQ ALT_PUNKT nil)
			       )
			     )
			     DUMMY
			   )
			 )
			 DATA
		       )
		     )
	       )
	     )
	   )
	   FONT_LIST
	 )
  )
  (SETQ B (DIMX_TILE IMAGE_NAME))
  (SETQ H (DIMY_TILE IMAGE_NAME))
  (SETQ W 15)
  (SETQ W_LIST nil)
  (REPEAT 16
    (SETQ W_LIST (CONS (* (/ (* 2.0 PI) 16.0) W) W_LIST))
    (SETQ W (1- W))
  )
  (SETQ	DATA_LIST
	 (MAPCAR
	   (QUOTE
	     (LAMBDA (DATA)
	       (CONS (STRCASE (CAR DATA))
		     (MAPCAR
		       (QUOTE (LAMBDA (DAT)
				(CONS (STRCASE (CAR DAT)) (CDR DAT))
			      )
		       )
		       (CDR DATA)
		     )
	       )
	     )
	   )
	   DATA_LIST
	 )
  )
  (FOREACH DATA	DATA_LIST
    (SETQ ART (CAR DATA))
    (SETQ DATA (CDR DATA))
    (COND ((= ART "FILL")
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (IF (SETQ P1 (CADR (ASSOC "P1" DATA)))
	     (SETQ P1X (:M-ROUND (* (/ B 100.0) (CAR P1)))
		   P1Y (:M-ROUND (* (/ H 100.0) (CADR P1)))
	     )
	     (SETQ P1X 0
		   P1Y 0
	     )
	   )
	   (IF (SETQ P2 (CADR (ASSOC "P2" DATA)))
	     (SETQ P2X (:M-ROUND
			 (- (* (/ B 100.0) (CAR P2)) (* (/ B 100.0) (CAR P1)))
		       )
		   P2Y (:M-ROUND
			 (- (* (/ H 100.0) (CADR P2)) (* (/ H 100.0) (CADR P1)))
		       )
	     )
	     (SETQ P2X B
		   P2Y H
	     )
	   )
	   (START_IMAGE IMAGE_NAME)
	   (FILL_IMAGE P1X P1Y P2X P2Y COLOR)
	   (END_IMAGE)
	  )
	  ((= ART "CIRCLE")
	   (SETQ CENTER (CADR (ASSOC "CENTER" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ RADIUS (CADR (ASSOC "RADIUS" DATA)))
	   (SETQ CENTER
		  (MAPCAR (QUOTE *)
			  (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			  CENTER
		  )
	   )
	   (SETQ RADIUS (* (/ 100.0 (APPLY (QUOTE MIN) (LIST B H))) RADIUS))
	   (IF (NULL (SETQ RATIO (CADR (ASSOC "RATIO" DATA))))
	     (SETQ RATIO 1.0)
	   )
	   (IF (NULL (SETQ WINKEL (CADR (ASSOC "ANGLE" DATA))))
	     (SETQ WINKEL 0)
	   )
	   (SETQ DUMMY_LIST
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (W)
			(MAPCAR
			  (QUOTE FIX)
			  (MAPCAR
			    (QUOTE +)
			    (K_P_TWIST
			      (MAPCAR (QUOTE *)
				      (POLAR (QUOTE (0 0)) W RADIUS)
				      (LIST 1.0 RATIO)
			      )
			      (QUOTE (0 0))
			      (- 0 WINKEL)
			    )
			    CENTER
			  )
			)
		      )
		    )
		    W_LIST
		  )
	   )
	   (SETQ
	     P_LIST (APPEND
		      P_LIST
		      (MAPCAR
			(QUOTE (LAMBDA (P1 P2) (LIST P1 P2 COLOR)))
			DUMMY_LIST
			(APPEND (CDR DUMMY_LIST) (LIST (CAR DUMMY_LIST)))
		      )
		    )
	   )
	  )
	  ((= ART "RECTANG")
	   (SETQ POSITION (CADR (ASSOC "POSITION" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ WIDTH (CADR (ASSOC "WIDTH" DATA)))
	   (SETQ HEIGHT (CADR (ASSOC "HEIGHT" DATA)))
	   (SETQ
	     POSITION (MAPCAR
			(QUOTE *)
			(MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			POSITION
		      )
	   )
	   (SETQ HEIGHT (* (/ H 100.0) HEIGHT))
	   (SETQ WIDTH (* (/ B 100.0) WIDTH))
	   (IF (NULL (SETQ WINKEL (CADR (ASSOC "ANGLE" DATA))))
	     (SETQ WINKEL 0)
	   )
	   (SETQ P1 (POLAR (POLAR (QUOTE (0 0)) 0 (/ WIDTH 2.0))
			   (* PI 1.5)
			   (/ HEIGHT 2.0)
		    )
	   )
	   (SETQ P2 (POLAR P1 (* PI 0.5) HEIGHT))
	   (SETQ P3 (POLAR P2 PI WIDTH))
	   (SETQ P4 (POLAR P3 (* PI 1.5) HEIGHT))
	   (SETQ DUMMY_LIST
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (P)
			(MAPCAR
			  (QUOTE :M-ROUND)
			  (MAPCAR
			    (QUOTE +)
			    (K_P_TWIST P (QUOTE (0 0)) (- 0 WINKEL))
			    POSITION
			  )
			)
		      )
		    )
		    (LIST P1 P2 P3 P4)
		  )
	   )
	   (SETQ
	     P_LIST (APPEND
		      P_LIST
		      (MAPCAR
			(QUOTE (LAMBDA (P1 P2) (LIST P1 P2 COLOR)))
			DUMMY_LIST
			(APPEND (CDR DUMMY_LIST) (LIST (CAR DUMMY_LIST)))
		      )
		    )
	   )
	  )
	  ((= ART "ARROW")
	   (SETQ START (CADR (ASSOC "START" DATA)))
	   (SETQ END (CADR (ASSOC "END" DATA)))
	   (SETQ SIZE (CADR (ASSOC "SIZE" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (IF (NOT (SETQ RATIO (CADR (ASSOC "RATIO" DATA))))
	     (SETQ RATIO 1.0)
	   )
	   (SETQ START
		  (MAPCAR (QUOTE *)
			  (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			  START
		  )
	   )
	   (SETQ
	     END (MAPCAR (QUOTE *)
			 (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			 END
		 )
	   )
	   (SETQ SIZE (* (/ 100.0 (APPLY (QUOTE MIN) (LIST B H))) SIZE))
	   (SETQ P1 (MAPCAR (QUOTE FIX)
			    (POLAR (POLAR END (ANGLE END START) SIZE)
				   (- (ANGLE END START) (/ PI 2.0))
				   (* SIZE RATIO 0.5)
			    )
		    )
	   )
	   (SETQ P2 (MAPCAR (QUOTE FIX)
			    (POLAR (POLAR END (ANGLE END START) SIZE)
				   (+ (ANGLE END START) (/ PI 2.0))
				   (* SIZE RATIO 0.5)
			    )
		    )
	   )
	   (SETQ
	     P3	(MAPCAR	(QUOTE FIX)
			(K_MIDP	(POLAR (POLAR END (ANGLE END START) SIZE)
				       (- (ANGLE END START) (/ PI 2.0))
				       (* SIZE RATIO 0.5)
				)
				(POLAR (POLAR END (ANGLE END START) SIZE)
				       (+ (ANGLE END START) (/ PI 2.0))
				       (* SIZE RATIO 0.5)
				)
			)
		)
	   )
	   (SETQ START (MAPCAR (QUOTE FIX) START))
	   (SETQ END (MAPCAR (QUOTE FIX) END))
	   (IF (SETQ FILLCOLOR (CADR (ASSOC "FILLCOLOR" DATA)))
	     (SETQ P_LIST
		    (APPEND
		      P_LIST
		      (MAPCAR
			(QUOTE
			  (LAMBDA (Q)
			    (LIST
			      END
			      (MAPCAR
				(QUOTE FIX)
				(INTERS P1 P2 END (POLAR END Q SIZE) nil)
			      )
			      FILLCOLOR
			    )
			  )
			)
			(K_ZAHLENREIHE_START_STEP
			  (* SIZE 2)
			  (ANGLE END P1)
			  (/ (K_WINKELDIFFERENZ_EFFEKTIV
			       (ANGLE END P1)
			       (ANGLE END P2)
			     )
			     (* SIZE 2)
			  )
			)
		      )
		    )
	     )
	   )
	   (SETQ P_LIST	(APPEND	P_LIST
				(LIST (LIST START P3 COLOR)
				      (LIST END P1 COLOR)
				      (LIST P1 P2 COLOR)
				      (LIST P2 END COLOR)
				)
			)
	   )
	  )
	  ((= ART "LINE")
	   (SETQ START (CADR (ASSOC "START" DATA)))
	   (SETQ END (CADR (ASSOC "END" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ START
		  (MAPCAR (QUOTE *)
			  (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			  START
		  )
	   )
	   (SETQ
	     END (MAPCAR (QUOTE *)
			 (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			 END
		 )
	   )
	   (SETQ START (MAPCAR (QUOTE FIX) START))
	   (SETQ END (MAPCAR (QUOTE FIX) END))
	   (SETQ P_LIST (APPEND P_LIST (LIST (LIST START END COLOR))))
	  )
	  ((= ART "PLINE")
	   (SETQ PLIST (CDR (ASSOC "PLIST" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ
	     PLIST (MAPCAR
		     (QUOTE (LAMBDA (P)
			      (SETQ
				P (MAPCAR (QUOTE FIX)
					  (MAPCAR (QUOTE *)
						  (MAPCAR (QUOTE /)
							  (LIST B H)
							  (LIST 100.0 100.0)
						  )
						  P
					  )
				  )
			      )
			    )
		     )
		     PLIST
		   )
	   )
	   (SETQ
	     P_LIST (APPEND
		      P_LIST
		      (MAPCAR (QUOTE (LAMBDA (P1 P2) (LIST P1 P2 COLOR)))
			      PLIST
			      (APPEND (CDR PLIST) (LIST (CAR PLIST)))
		      )
		    )
	   )
	  )
	  ((= ART "TEXT")
	   (SETQ TEXT (CADR (ASSOC "TEXT" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ HOEHE (CADR (ASSOC "HEIGHT" DATA)))
	   (SETQ BREITE (CADR (ASSOC "WIDTH" DATA)))
	   (IF (NULL BREITE)
	     (SETQ BREITE 1.0)
	   )
	   (SETQ CHR_LIST (MAPCAR (QUOTE CHR) (VL-STRING->LIST TEXT)))
	   (SETQ POS (CADR (ASSOC "POSITION" DATA)))
	   (SETQ RICHTUNG (CADR (ASSOC "ALIGNMENT" DATA)))
	   (IF (NULL RICHTUNG)
	     (SETQ RICHTUNG "lo")
	   )
	   (SETQ WINKEL (CADR (ASSOC "ANGLE" DATA)))
	   (IF (NULL WINKEL)
	     (SETQ WINKEL 0)
	   )
	   (SETQ
	     POS (MAPCAR (QUOTE *)
			 (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			 POS
		 )
	   )
	   (SETQ HOEHE (* (/ H 100.0) HOEHE))
	   (SETQ DUMMY_LIST
		  (MAPCAR (QUOTE (LAMBDA (C)
				   (SETQ TEMP_LIST
					  (MAPCAR
					    (QUOTE
					      (LAMBDA (PL)
						(MAPCAR	(QUOTE *)
							PL
							(LIST 1 HOEHE HOEHE)
						)
					      )
					    )
					    (CADR (ASSOC C FONT_LIST))
					  )
				   )
				   (SETQ C_LIST
					  (VL-REMOVE
					    (QUOTE nil)
					    (MAPCAR
					      (QUOTE
						(LAMBDA	(P1 P2)
						  (COND
						    ((AND (= (CAR P1) 1)
							  (= (CAR P2) 1)
						     )
						     (LIST
						       (MAPCAR
							 (QUOTE (LAMBDA (Z) Z))
							 (MAPCAR
							   (QUOTE +)
							   POS
							   (MAPCAR
							     (QUOTE *)
							     (CDR P1)
							     (LIST BREITE 1)
							   )
							 )
						       )
						       (MAPCAR
							 (QUOTE (LAMBDA (Z) Z))
							 (MAPCAR
							   (QUOTE +)
							   POS
							   (MAPCAR
							     (QUOTE *)
							     (CDR P2)
							     (LIST BREITE 1)
							   )
							 )
						       )
						       COLOR
						     )
						    )
						    ((= (CAR P2) 2)
						     (SETQ POS
							    (MAPCAR
							      (QUOTE +)
							      POS
							      (MAPCAR
								(QUOTE *)
								(CDR P2)
								(LIST BREITE 1)
							      )
							    )
						     )
						     nil
						    )
						  )
						)
					      )
					      (I-CDR TEMP_LIST)
					      (CDR TEMP_LIST)
					    )
					  )
				   )
				   (SETQ POS
					  (LIST
					    (MAX
					      (CAR POS)
					      (+ 2
						 (APPLY
						   (QUOTE MAX)
						   (MAPCAR (QUOTE CAR)
							   (VL-REMOVE-IF-NOT
							     (QUOTE LISTP)
							     (APPLY (QUOTE APPEND)
								    C_LIST
							     )
							   )
						   )
						 )
					      )
					    )
					    (CADR POS)
					  )
				   )
				   C_LIST
				 )
			  )
			  CHR_LIST
		  )
	   )
	   (SETQ DUMMY_LIST (APPLY (QUOTE APPEND) DUMMY_LIST))
	   (SETQ Y-LIST	(APPEND	(MAPCAR (QUOTE CAAR) DUMMY_LIST)
				(MAPCAR (QUOTE CAADR) DUMMY_LIST)
			)
	   )
	   (SETQ X-LIST	(APPEND	(MAPCAR (QUOTE CADAR) DUMMY_LIST)
				(MAPCAR (QUOTE CADADR) DUMMY_LIST)
			)
	   )
	   (SETQ MIN-Y (APPLY (QUOTE MIN) Y-LIST))
	   (SETQ MAX-Y (APPLY (QUOTE MAX) Y-LIST))
	   (SETQ MIN-X (APPLY (QUOTE MIN) X-LIST))
	   (SETQ MAX-X (APPLY (QUOTE MAX) X-LIST))
	   (SETQ DX (- MAX-X MIN-X))
	   (SETQ DY (- MAX-Y MIN-Y))
	   (COND ((= RICHTUNG "ol") nil)
		 ((= RICHTUNG "ml")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST 0 (/ DX 2))
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST 0 (/ DX 2))
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "ul")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST 0 DX)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST 0 DX)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "oz")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST (/ DY 2) 0)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST (/ DY 2) 0)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "mz")
		  (SETQ	DUMMY_LIST
			 (MAPCAR
			   (QUOTE (LAMBDA (DUMMY)
				    (LIST (MAPCAR (QUOTE -)
						  (CAR DUMMY)
						  (LIST (/ DY 2) (/ DX 2))
					  )
					  (MAPCAR (QUOTE -)
						  (CADR DUMMY)
						  (LIST (/ DY 2) (/ DX 2))
					  )
					  (CADDR DUMMY)
				    )
				  )
			   )
			   DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "uz")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST (/ DY 2) DX)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST (/ DY 2) DX)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "or")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST DY 0)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST DY 0)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "mr")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST DY (/ DX 2))
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST DY (/ DX 2))
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "ur")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST DY DX)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST DY DX)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
	   )
	   (SETQ
	     POS (MAPCAR (QUOTE *)
			 (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			 (CADR (ASSOC "POSITION" DATA))
		 )
	   )
	   (SETQ DUMMY_LIST
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (DUMMY)
			(LIST
			  (:M-ROUNDTOEVEN
			    (K_P_TWIST (CAR DUMMY) POS (- 0 WINKEL))
			  )
			  (:M-ROUNDTOEVEN
			    (K_P_TWIST (CADR DUMMY) POS (- 0 WINKEL))
			  )
			  (LAST DUMMY)
			)
		      )
		    )
		    DUMMY_LIST
		  )
	   )
	   (SETQ P_LIST (APPEND P_LIST DUMMY_LIST))
	  )
    )
  )
  (START_IMAGE IMAGE_NAME)
  (MAPCAR (QUOTE (LAMBDA (DATA)
		   (VECTOR_IMAGE
		     (NTH 0 (NTH 0 DATA))
		     (NTH 1 (NTH 0 DATA))
		     (NTH 0 (NTH 1 DATA))
		     (NTH 1 (NTH 1 DATA))
		     (NTH 2 DATA)
		   )
		 )
	  )
	  P_LIST
  )
  (END_IMAGE)
)
(DEFUN K_ENTLIST->SATZ (ENT_LIST / N SATZ ENT_NAME)
  (IF (NOT (LISTP ENT_LIST))
    (SETQ ENT_LIST (LIST ENT_LIST))
  )
  (IF (LISTP ENT_LIST)
    (PROGN (SETQ SATZ (SSADD))
	   (MAPCAR
	     (QUOTE
	       (LAMBDA (ENT_NAME)
		 (COND ((AND (= (TYPE ENT_NAME) (QUOTE VLA-OBJECT))
			     (K_->ENT_NAME ENT_NAME)
			)
			(SETQ
			  SATZ (SSADD (vlax-vla-object->ename ENT_NAME) SATZ)
			)
		       )
		       ((AND (= (TYPE ENT_NAME) (QUOTE ENAME))
			     (K_->OBJ_NAME ENT_NAME)
			)
			(SETQ SATZ (SSADD ENT_NAME SATZ))
		       )
		       ((= (TYPE ENT_NAME) (QUOTE STR))
			(IF (HANDENT ENT_NAME)
			  (SETQ SATZ (SSADD (HANDENT ENT_NAME) SATZ))
			)
		       )
		 )
	       )
	     )
	     ENT_LIST
	   )
    )
  )
  SATZ
)
(DEFUN K_GET-TEXTSTRING	(ENT_NAME / ENT_DATA)
  (SETQ	ENT_DATA
	 (COND ((= (TYPE ENT_NAME) (QUOTE VLA-OBJECT))
		(ENTGET (vlax-vla-object->ename ENT_NAME))
	       )
	       ((= (TYPE ENT_NAME) (QUOTE ENAME)) (ENTGET ENT_NAME))
	       ((= (TYPE ENT_NAME) (QUOTE LIST)) ENT_NAME)
	 )
  )
  (WHILE (> (LENGTH (K_GET_ASSOC ENT_DATA 1)) 1)
    (SETQ
      ENT_DATA (K_DEL-NTH ENT_DATA
			  (VL-POSITION (ASSOC 1 ENT_DATA) ENT_DATA)
	       )
    )
  )
  (COND
    ((= (CDR (ASSOC 0 ENT_DATA)) "ATTDEF")
     (APPLY (QUOTE STRCAT)
	    (MAPCAR (QUOTE CDR)
		    (APPEND (K_GET_ASSOC ENT_DATA (QUOTE (1)))
			    (CDR (K_GET_ASSOC ENT_DATA (QUOTE (3))))
		    )
	    )
     )
    )
    ((MEMBER (CDR (ASSOC 0 ENT_DATA))
	     (QUOTE ("TEXT" "MTEXT" "ATTRIB"))
     )
     (APPLY (QUOTE STRCAT)
	    (MAPCAR (QUOTE CDR) (K_GET_ASSOC ENT_DATA (QUOTE (1 3))))
     )
    )
    ((MEMBER (CDR (ASSOC 0 ENT_DATA)) (QUOTE ("MULTILEADER")))
     (vla-get-TextString
       (vlax-ename->vla-object (CDR (ASSOC -1 ENT_DATA)))
     )
    )
    (T nil)
  )
)
(DEFUN K_GET_ASSOC (LISTE GRUPPE)
  (IF (/= (TYPE GRUPPE) (QUOTE LIST))
    (SETQ GRUPPE (LIST GRUPPE))
  )
  (VL-REMOVE-IF-NOT
    (QUOTE (LAMBDA (DATA) (MEMBER (CAR DATA) GRUPPE)))
    LISTE
  )
)
(DEFUN K_GET_ATTS (OBJ_NAME)
  (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 (QUOTE GETATTRIBUTES))
  )
)
(DEFUN K_GET_DATA (OBJ_NAMEN BEZ APP_LIST ART /)
  (DEFUN K_GET_DATA_WORK (OBJ_NAME  /	      ATT_LIST	DAT
			  DATA	    DATA_LIST DYN_LIST	ML_LIST
			  OBJ	    PROP      XDATA	XTYPE
			 )
    (IF	(AND OBJ_NAME (ENTGET (K_->ENT_NAME OBJ_NAME)))
      (PROGN
	(IF (= (TYPE APP_LIST) (QUOTE STR))
	  (SETQ APP_LIST (LIST APP_LIST))
	)
	(IF (= (TYPE ART) (QUOTE STR))
	  (SETQ ART (LIST ART))
	)
	(IF (= (TYPE OBJ_NAME) (QUOTE ENAME))
	  (SETQ OBJ_NAME (vlax-ename->vla-object OBJ_NAME))
	)
	(IF
	  (AND
	    (OR (NULL ART) (MEMBER "ATT" (MAPCAR (QUOTE STRCASE) ART)))
	    (SETQ ATT_OBJ_LIST
		   (MAPCAR (QUOTE K_->OBJ_NAME)
			   (K_GET_SUBOBJ OBJ_NAME)
		   )
	    )
	  )
	   (SETQ ATT_LIST
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (OBJ)
			(LIST
			  (CDR (ASSOC 2 (ENTGET (K_->ENT_NAME OBJ))))
			  (CDR (ASSOC 1 (ENTGET (K_->ENT_NAME OBJ))))
			)
		      )
		    )
		    ATT_OBJ_LIST
		  )
	   )
	   (SETQ
	     ATT_LIST (MAPCAR (QUOTE (LAMBDA (OBJ)
				       (LIST (vla-get-TagString OBJ)
					     (K_GET-TEXTSTRING OBJ)
				       )
				     )
			      )
			      ATT_OBJ_LIST
		      )
	   )
	)
	(IF
	  (AND
	    (OR (NULL ART) (MEMBER "DYN" (MAPCAR (QUOTE STRCASE) ART)))
	    (vlax-property-available-p OBJ_NAME "isdynamicblock")
	    (= (vla-get-IsDynamicBlock OBJ_NAME) :vlax-true)
	    (vlax-method-applicable-p
	      OBJ_NAME
	      (QUOTE GETDYNAMICBLOCKPROPERTIES)
	    )
	  )
	   (SETQ DYN_LIST
		  (VL-REMOVE
		    (QUOTE nil)
		    (MAPCAR
		      (QUOTE (LAMBDA (PROP)
			       (IF (= (vla-get-Show PROP) :vlax-true)
				 (LIST (vla-get-PropertyName PROP)
				       (vlax-variant-value
					 (vla-get-Value PROP)
				       )
				 )
			       )
			     )
		      )
		      (vlax-invoke
			OBJ_NAME
			(QUOTE GETDYNAMICBLOCKPROPERTIES)
		      )
		    )
		  )
	   )
	)
	(IF
	  (AND
	    (OR (NULL ART) (MEMBER "EED" (MAPCAR (QUOTE STRCASE) ART)))
	    (MEMBER "*" APP_LIST)
	  )
	   (VLAX-FOR APP (vla-get-RegisteredApplications
			   (vla-get-Document OBJ_NAME)
			 )
	     (IF (AND (NOT (VL-CATCH-ALL-ERROR-P
			     (VL-CATCH-ALL-APPLY
			       (QUOTE vla-GetXData)
			       (LIST OBJ_NAME
				     (vla-get-Name APP)
				     (QUOTE XTYPE)
				     (QUOTE XDATA)
			       )
			     )
			   )
		      )
		      XTYPE
		      XDATA
		 )
	       (PROGN (vlax-safearray->list XTYPE)
		      (SETQ DATA_LIST
			     (APPEND
			       DATA_LIST
			       (VL-REMOVE-IF-NOT
				 (QUOTE
				   (LAMBDA (DATA)
				     (= (TYPE (CAR DATA)) (QUOTE STR))
				   )
				 )
				 (GATHER
				   (CDR
				     (MAPCAR (QUOTE vlax-variant-value)
					     (vlax-safearray->list XDATA)
				     )
				   )
				   2
				 )
			       )
			     )
		      )
	       )
	     )
	   )
	   (FOREACH APP	APP_LIST
	     (IF
	       (AND
		 (NOT (VL-CATCH-ALL-ERROR-P
			(VL-CATCH-ALL-APPLY
			  (QUOTE vla-GetXData)
			  (LIST OBJ_NAME APP (QUOTE XTYPE) (QUOTE XDATA))
			)
		      )
		 )
		 XTYPE
		 XDATA
	       )
		(PROGN (vlax-safearray->list XTYPE)
		       (SETQ DATA_LIST
			      (APPEND
				DATA_LIST
				(VL-REMOVE-IF-NOT
				  (QUOTE
				    (LAMBDA (DATA)
				      (= (TYPE (CAR DATA)) (QUOTE STR))
				    )
				  )
				  (GATHER
				    (CDR
				      (MAPCAR (QUOTE vlax-variant-value)
					      (vlax-safearray->list XDATA)
				      )
				    )
				    2
				  )
				)
			      )
		       )
		)
	     )
	   )
	)
	(COND
	  ((= (TYPE BEZ) (QUOTE STR))
	   (IF (= BEZ "*")
	     (PROGN
	       (SETQ DATA (APPEND ML_LIST ATT_LIST DATA_LIST DYN_LIST))
	     )
	     (PROGN (SETQ
		      DATA (COND
			     ((vlax-property-available-p OBJ_NAME BEZ)
			      (IF (VL-CATCH-ALL-ERROR-P
				    (SETQ DATA
					   (VL-CATCH-ALL-APPLY
					     (QUOTE getpropertyvalue)
					     (LIST (K_->ENT_NAME OBJ_NAME) BEZ)
					   )
				    )
				  )
				(SETQ DATA
				       (EVAL
					 (LIST (READ (STRCAT "vla-get-" BEZ))
					       OBJ_NAME
					 )
				       )
				)
				DATA
			      )
			     )
			     ((ASSOC BEZ ML_LIST)
			      (SETQ DATA (NTH 1 (ASSOC BEZ ML_LIST)))
			     )
			     ((ASSOC
				(STRCASE BEZ)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (DAT)
				      (LIST (STRCASE (CAR DAT)) (CADR DAT))
				    )
				  )
				  ML_LIST
				)
			      )
			      (SETQ DATA
				     (NTH
				       1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE (LAMBDA (DAT)
						    (LIST (STRCASE (CAR DAT))
							  (CADR DAT)
						    )
						  )
					   )
					   ML_LIST
					 )
				       )
				     )
			      )
			     )
			     ((ASSOC BEZ DYN_LIST)
			      (SETQ DATA (NTH 1 (ASSOC BEZ DYN_LIST)))
			     )
			     ((ASSOC
				(STRCASE BEZ)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (DAT)
				      (LIST (STRCASE (CAR DAT)) (CADR DAT))
				    )
				  )
				  DYN_LIST
				)
			      )
			      (SETQ DATA
				     (NTH
				       1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE (LAMBDA (DAT)
						    (LIST (STRCASE (CAR DAT))
							  (CADR DAT)
						    )
						  )
					   )
					   DYN_LIST
					 )
				       )
				     )
			      )
			     )
			     ((ASSOC BEZ ATT_LIST)
			      (SETQ DATA (NTH 1 (ASSOC BEZ ATT_LIST)))
			     )
			     ((ASSOC
				(STRCASE BEZ)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (DAT)
				      (LIST (STRCASE (CAR DAT)) (CADR DAT))
				    )
				  )
				  ATT_LIST
				)
			      )
			      (SETQ DATA
				     (NTH
				       1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE (LAMBDA (DAT)
						    (LIST (STRCASE (CAR DAT))
							  (CADR DAT)
						    )
						  )
					   )
					   ATT_LIST
					 )
				       )
				     )
			      )
			     )
			     ((ASSOC BEZ DATA_LIST)
			      (SETQ DATA (NTH 1 (ASSOC BEZ DATA_LIST)))
			     )
			     ((ASSOC
				(STRCASE BEZ)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (DAT)
				      (LIST (STRCASE (CAR DAT)) (CADR DAT))
				    )
				  )
				  DATA_LIST
				)
			      )
			      (SETQ DATA
				     (NTH
				       1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE (LAMBDA (DAT)
						    (LIST (STRCASE (CAR DAT))
							  (CADR DAT)
						    )
						  )
					   )
					   DATA_LIST
					 )
				       )
				     )
			      )
			     )
			   )
		    )
	     )
	   )
	  )
	  ((= (TYPE BEZ) (QUOTE LIST))
	   (SETQ DATA
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (BEZ / DATA)
			(COND
			  ((vlax-property-available-p OBJ_NAME BEZ)
			   (IF (VL-CATCH-ALL-ERROR-P
				 (SETQ
				   DATA	(VL-CATCH-ALL-APPLY
					  (QUOTE getpropertyvalue)
					  (LIST	(K_->ENT_NAME OBJ_NAME)
						BEZ
					  )
					)
				 )
			       )
			     (SETQ
			       DATA (EVAL
				      (LIST
					(READ (STRCAT "vla-get-" BEZ))
					OBJ_NAME
				      )
				    )
			     )
			   )
			  )
			  ((ASSOC BEZ DYN_LIST)
			   (SETQ DATA (NTH 1 (ASSOC BEZ DYN_LIST)))
			  )
			  ((ASSOC
			     (STRCASE BEZ)
			     (MAPCAR
			       (QUOTE
				 (LAMBDA (DAT)
				   (LIST (STRCASE (CAR DAT)) (CADR DAT))
				 )
			       )
			       DYN_LIST
			     )
			   )
			   (SETQ DATA
				  (NTH 1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE
					     (LAMBDA (DAT)
					       (LIST (STRCASE (CAR DAT))
						     (CADR DAT)
					       )
					     )
					   )
					   DYN_LIST
					 )
				       )
				  )
			   )
			  )
			  ((ASSOC BEZ ATT_LIST)
			   (SETQ DATA (NTH 1 (ASSOC BEZ ATT_LIST)))
			  )
			  ((ASSOC
			     (STRCASE BEZ)
			     (MAPCAR
			       (QUOTE
				 (LAMBDA (DAT)
				   (LIST (STRCASE (CAR DAT)) (CADR DAT))
				 )
			       )
			       ATT_LIST
			     )
			   )
			   (SETQ DATA
				  (NTH 1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE
					     (LAMBDA (DAT)
					       (LIST (STRCASE (CAR DAT))
						     (CADR DAT)
					       )
					     )
					   )
					   ATT_LIST
					 )
				       )
				  )
			   )
			  )
			  ((ASSOC BEZ DATA_LIST)
			   (SETQ DATA (NTH 1 (ASSOC BEZ DATA_LIST)))
			  )
			  ((ASSOC
			     (STRCASE BEZ)
			     (MAPCAR
			       (QUOTE
				 (LAMBDA (DAT)
				   (LIST (STRCASE (CAR DAT)) (CADR DAT))
				 )
			       )
			       DATA_LIST
			     )
			   )
			   (SETQ DATA
				  (NTH 1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE
					     (LAMBDA (DAT)
					       (LIST (STRCASE (CAR DAT))
						     (CADR DAT)
					       )
					     )
					   )
					   DATA_LIST
					 )
				       )
				  )
			   )
			  )
			)
			(LIST BEZ DATA)
		      )
		    )
		    BEZ
		  )
	   )
	  )
	)
      )
    )
    DATA
  )
  (COND	((LISTP OBJ_NAMEN)
	 (MAPCAR (QUOTE K_GET_DATA_WORK) OBJ_NAMEN)
	)
	((= (TYPE OBJ_NAMEN) (QUOTE PICKSET))
	 (MAPCAR (QUOTE K_GET_DATA_WORK) (K_SATZ->ENTLIST OBJ_NAMEN))
	)
	(T (K_GET_DATA_WORK OBJ_NAMEN))
  )
)
(DEFUN K_GET_DATA_ACAD (OBJ_NAMEN / OBJ PROP)
  (DEFUN K_GET_DATA_WORK (OBJ_NAME / PROP XDATA XTYPE)
    (VL-REMOVE
      (QUOTE nil)
      (APPLY
	(QUOTE APPEND)
	(LIST
	  (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
		     )
		   )
	      )
	    )
	     (MAPCAR
	       (QUOTE
		 (LAMBDA (OBJ)
		   (LIST (vla-get-TagString OBJ) (K_GET-TEXTSTRING OBJ))
		 )
	       )
	       (vlax-invoke OBJ_NAME (QUOTE GETATTRIBUTES))
	     )
	  )
	  (IF
	    (AND (vlax-property-available-p OBJ_NAME "isdynamicblock")
		 (= (vla-get-IsDynamicBlock OBJ_NAME) :vlax-true)
		 (vlax-method-applicable-p
		   OBJ_NAME
		   (QUOTE GETDYNAMICBLOCKPROPERTIES)
		 )
	    )
	     (VL-REMOVE
	       (QUOTE nil)
	       (MAPCAR
		 (QUOTE
		   (LAMBDA (PROP)
		     (IF (= (vla-get-Show PROP) :vlax-true)
		       (LIST (vla-get-PropertyName PROP)
			     (vlax-variant-value (vla-get-Value PROP))
		       )
		     )
		   )
		 )
		 (vlax-invoke OBJ_NAME (QUOTE GETDYNAMICBLOCKPROPERTIES))
	       )
	     )
	  )
	)
      )
    )
  )
  (COND	((LISTP OBJ_NAMEN)
	 (MAPCAR (QUOTE K_GET_DATA_WORK)
		 (MAPCAR (QUOTE K_->OBJ_NAME) OBJ_NAMEN)
	 )
	)
	((= (TYPE OBJ_NAMEN) (QUOTE PICKSET))
	 (MAPCAR (QUOTE K_GET_DATA_WORK) (K_SATZ->OBJLIST OBJ_NAMEN))
	)
	(T (K_GET_DATA_WORK (K_->OBJ_NAME OBJ_NAMEN)))
  )
)
(DEFUN K_GET_SUBOBJ (ENT_NAME / DATA_LIST)
  (SETQ ENT_NAME (K_->ENT_NAME ENT_NAME))
  (COND	((AND (= (CDR (ASSOC 0 (ENTGET ENT_NAME))) "POLYLINE")
	      (= (CDR (ASSOC 66 (ENTGET ENT_NAME))) 1)
	 )
	 (SETQ ENT_NAME (ENTNEXT ENT_NAME))
	 (WHILE	(/= (CDR (ASSOC 0 (ENTGET ENT_NAME))) "SEQEND")
	   (SETQ DATA_LIST (CONS (ENTGET ENT_NAME) DATA_LIST))
	   (SETQ ENT_NAME (ENTNEXT ENT_NAME))
	 )
	)
	((AND (= (CDR (ASSOC 0 (ENTGET ENT_NAME))) "INSERT")
	      (= (CDR (ASSOC 66 (ENTGET ENT_NAME))) 1)
	 )
	 (SETQ ENT_NAME (ENTNEXT ENT_NAME))
	 (WHILE	(/= (CDR (ASSOC 0 (ENTGET ENT_NAME))) "SEQEND")
	   (SETQ DATA_LIST (CONS (ENTGET ENT_NAME) DATA_LIST))
	   (SETQ ENT_NAME (ENTNEXT ENT_NAME))
	 )
	)
  )
  (REVERSE DATA_LIST)
)
(DEFUN K_GET_TILE_LISTE	(LISTE AUSWAHL)
  (MAPCAR (QUOTE (LAMBDA (N) (NTH N LISTE)))
	  (EVAL (READ (STRCAT "(list " AUSWAHL ")")))
  )
)
(DEFUN K_GROUP_ASSOC (LISTE PROP / FERTIG_LIST)
  (WHILE LISTE
    (SETQ DUMMY (ASSOC PROP (CAR LISTE)))
    (SETQ FERTIG_LIST
	   (CONS
	     (VL-REMOVE-IF-NOT
	       (QUOTE
		 (LAMBDA (DATA) (EQUAL (ASSOC PROP DATA) DUMMY))
	       )
	       LISTE
	     )
	     FERTIG_LIST
	   )
    )
    (SETQ
      LISTE (VL-REMOVE-IF
	      (QUOTE (LAMBDA (DATA) (EQUAL (ASSOC PROP DATA) DUMMY)))
	      LISTE
	    )
    )
  )
  (REVERSE FERTIG_LIST)
)
(DEFUN K_MIDP (P1 P2)
  (SETQ MIDP (MAPCAR (QUOTE (LAMBDA (X1 X2) (/ (+ X1 X2) 2))) P1 P2))
)
(DEFUN K_MK_DRIVES_LIST	(/	       VLA-FILEOBJ   DRIVES
			 DRIVE	       DRIVEPATH     DRIVES_LIST
			 VOLUMENAME    SERIALNUMBER
			)
  (VL-LOAD-COM)
  (SETQ VLA-FILEOBJ (vlax-create-object "Scripting.FileSystemObject"))
  (SETQ DRIVES (vlax-get-property VLA-FILEOBJ (QUOTE DRIVES)))
  (VLAX-FOR DRIVE DRIVES
    (SETQ DRIVEPATH (vlax-get-property DRIVE (QUOTE PATH)))
    (SETQ DRIVETYPE (vlax-get-property DRIVE (QUOTE DRIVETYPE)))
    (IF	(= (TYPE DRIVETYPE) (QUOTE variant))
      (SETQ DRIVETYPE (variant-value DRIVETYPE))
    )
    (COND ((= DRIVETYPE 0) (SETQ DRIVETYPE "Unbekannt"))
	  ((= DRIVETYPE 1) (SETQ DRIVETYPE "Austauschbar"))
	  ((= DRIVETYPE 2) (SETQ DRIVETYPE "Fest"))
	  ((= DRIVETYPE 3) (SETQ DRIVETYPE "Netzwerk"))
	  ((= DRIVETYPE 4) (SETQ DRIVETYPE "CD-ROM"))
	  ((= DRIVETYPE 5) (SETQ DRIVETYPE "RAM-Laufwerk"))
    )
    (IF	(VL-CATCH-ALL-ERROR-P
	  (SETQ	VOLUMENAME
		 (VL-CATCH-ALL-APPLY
		   (QUOTE vlax-get-property)
		   (LIST DRIVE (QUOTE VOLUMENAME))
		 )
	  )
	)
      (SETQ VOLUMENAME "")
    )
    (IF	(VL-CATCH-ALL-ERROR-P
	  (SETQ	SERIALNUMBER
		 (VL-CATCH-ALL-APPLY
		   (QUOTE vlax-get-property)
		   (LIST DRIVE (QUOTE SERIALNUMBER))
		 )
	  )
	)
      (SETQ SERIALNUMBER nil)
    )
    (SETQ DRIVES_LIST
	   (APPEND DRIVES_LIST
		   (LIST (LIST (STRCASE DRIVEPATH)
			       DRIVETYPE
			       VOLUMENAME
			       SERIALNUMBER
			 )
		   )
	   )
    )
  )
  DRIVES_LIST
)
(DEFUN K_MK_SUBSTR_LIST
       (TEXT FILTER ENTF / F_LIST ERGEBNIS_LIST POS START)
  (IF (WCMATCH TEXT FILTER)
    (PROGN
      (SETQ F_LIST (K_WCMATCH_POS TEXT FILTER)
	    POS	   1
      )
      (FOREACH TEIL F_LIST
	(SETQ START (NTH 0 TEIL))
	(IF (> START POS)
	  (SETQ	ERGEBNIS_LIST
		 (CONS (LIST POS (- START POS)) ERGEBNIS_LIST)
	  )
	  (SETQ ERGEBNIS_LIST (CONS (LIST POS 0) ERGEBNIS_LIST))
	)
	(IF ENTF
	  (SETQ ERGEBNIS_LIST (CONS TEIL ERGEBNIS_LIST))
	)
	(SETQ POS (+ START (NTH 1 TEIL)))
      )
      (IF
	(<= (SETQ START (+ (NTH 0 (LAST F_LIST)) (NTH 1 (LAST F_LIST))))
	    (STRLEN TEXT)
	)
	 (SETQ ERGEBNIS_LIST (CONS (LIST START nil) ERGEBNIS_LIST))
      )
      (VL-REMOVE-IF
	(QUOTE (LAMBDA (DUMMY) (= (CADR DUMMY) 0)))
	(REVERSE ERGEBNIS_LIST)
      )
    )
    (QUOTE ((1 nil)))
  )
)
(DEFUN K_OBJLIST->SATZ (OBJ_LIST)
  (IF (NOT (LISTP OBJ_LIST))
    (SETQ OBJ_LIST (LIST OBJ_LIST))
  )
  (K_ENTLIST->SATZ
    (MAPCAR (QUOTE vlax-vla-object->ename) OBJ_LIST)
  )
)
(DEFUN K_ODBX_CONSTRUCT	nil
  (vla-GetInterfaceObject
    (vlax-get-acad-object)
    (STRCAT "ObjectDBX.AxDbDocument."
	    (SUBSTR (GETVAR (QUOTE ACADVER)) 1 2)
    )
  )
)
(DEFUN K_PATHSLASH (PFAD REMOVE)
  (IF (AND PFAD (/= PFAD ""))
    (PROGN
      (SETQ PFAD (K_TXT-SUBST PFAD "\\" "/"))
      (COND ((AND REMOVE (= (SUBSTR PFAD (STRLEN PFAD) 1) "/"))
	     (SETQ PFAD (SUBSTR PFAD 1 (1- (STRLEN PFAD))))
	    )
	    ((AND (NOT REMOVE) (/= (SUBSTR PFAD (STRLEN PFAD) 1) "/"))
	     (SETQ PFAD (STRCAT PFAD "/"))
	    )
      )
    )
  )
  PFAD
)
(DEFUN K_PFADWAHL (WAHLPFAD	       TEXT
		   EXT_LIST	       CHECK
		   MULTI	       /
		   WAHLPFAD_NEU	       DRIVE_LIST
		   PFAD		       PFAD_LIST
		   K_PFADWAHL_ID       K_PFADWAHL_OK
		   WERT		       WAHLFILE_NEU_LIST
		   K_END_PFADWAHL      K_PFADWAHL_DRIVE_LIST
		   K_PFADWAHL_PFAD_LIST
		   K_PFADWAHL_ZEIGEN   K_PFADWAHL_FILE_LIST
		   K_PFADWAHL_CHECK    K_PFADWAHL_ORDNER_NEU
		   K_PFADWAHL_WAHLPFAD
		  )
  (DEFUN K_END_PFADWAHL	(WERT)
    (SETQ K_PFADWAHL_OK WERT)
    (DONE_DIALOG)
  )
  (DEFUN K_PFADWAHL_DRIVE_LIST nil
    (SETQ WAHLPFAD_NEU
	   (K_PATHSLASH
	     (NTH (ATOI (GET_TILE "drive_list")) DRIVE_LIST)
	     nil
	   )
    )
    (K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
  )
  (DEFUN K_PFADWAHL_PFAD_LIST (/ EXTENSION PFAD)
    (IF	(= $REASON 4)
      (PROGN
	(SETQ WAHLPFAD_LIST nil)
	(SETQ PFAD (NTH (ATOI (GET_TILE "pfad_list")) PFAD_LIST))
	(IF (EQUAL PFAD "..")
	  (IF
	    (NOT
	      (EQUAL (SETQ WAHLPFAD_DUMMY (K_CUT_PFADLAST WAHLPFAD_NEU))
		     ""
	      )
	    )
	     (SETQ WAHLPFAD_NEU (K_PATHSLASH WAHLPFAD_DUMMY nil))
	  )
	  (PROGN (SETQ WAHLPFAD_NEU
			(K_PATHSLASH
			  (VL-STRING-SUBST
			    "/"
			    "//"
			    (STRCAT WAHLPFAD_NEU "/" PFAD)
			  )
			  nil
			)
		 )
	  )
	)
	(K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
      )
      (SETQ WAHLPFAD_LIST
	     (MAPCAR
	       (QUOTE (LAMBDA (N)
			(VL-STRING-SUBST
			  "/"
			  "//"
			  (STRCAT WAHLPFAD_NEU
				  "/"
				  (NTH N PFAD_LIST)
			  )
			)
		      )
	       )
	       (EVAL
		 (READ (STRCAT "'(" (GET_TILE "pfad_list") ")")
		 )
	       )
	     )
      )
    )
  )
  (DEFUN K_PFADWAHL_ZEIGEN (PFAD)
    (SETQ PFAD_LIST (VL-DIRECTORY-FILES PFAD nil -1)
	  PFAD_LIST (K_VL-SORT PFAD_LIST (QUOTE <))
    )
    (IF	(AND (NOT (MEMBER (STRCASE PFAD) DRIVE_LIST))
	     (NOT (MEMBER ".." PFAD_LIST))
	)
      (SETQ PFAD_LIST (CONS ".." PFAD_LIST))
    )
    (SETQ PFAD_LIST (VL-REMOVE "." PFAD_LIST))
    (IF	EXT_LIST
      (PROGN (SETQ FILE_LIST (LIST))
	     (FOREACH EXT EXT_LIST
	       (SETQ FILE_LIST
		      (APPEND FILE_LIST (VL-DIRECTORY-FILES PFAD EXT 1))
	       )
	     )
	     (SETQ FILE_LIST (K_VL-SORT FILE_LIST (QUOTE <)))
      )
    )
    (SET_TILE "check" "")
    (IF	EXT_LIST
      (PROGN (START_LIST "file_list")
	     (MAPCAR (QUOTE ADD_LIST) FILE_LIST)
	     (END_LIST)
      )
    )
    (START_LIST "pfad_list")
    (MAPCAR (QUOTE ADD_LIST) PFAD_LIST)
    (END_LIST)
    (SET_TILE "wahlpfad" PFAD)
  )
  (DEFUN K_PFADWAHL_FILE_LIST nil
    (SETQ WAHLPFAD_LIST nil)
    (SET_TILE "pfad_list" "")
    (SETQ WAHL		    (READ (STRCAT "(" (GET_TILE "file_list") ")"))
	  WAHLFILE_NEU_LIST (MAPCAR
			      (QUOTE (LAMBDA (DUMMY) (NTH DUMMY FILE_LIST)))
			      WAHL
			    )
    )
    (K_PFADWAHL_CHECK CHECK)
    (IF	(= $REASON 4)
      (K_END_PFADWAHL 1)
    )
  )
  (DEFUN K_PFADWAHL_CHECK (CHECK)
    (IF	(AND CHECK WAHLFILE_NEU)
      (FOREACH WAHLFILE_NEU WAHLFILE_NEU_LIST
	(IF (FINDFILE WAHLFILE_NEU)
	  (SET_TILE "check_txt" "in Supportpfaden")
	  (SET_TILE "check_txt" "nicht in Supportpfaden")
	)
      )
    )
  )
  (DEFUN K_PFADWAHL_ORDNER_NEU (/ PFAD ORDNERNAME)
    (IF	(AND (SETQ ORDNERNAME (K_TXT_INPUT_1 "Verzeichnisname" "" ""))
	     (NOT (EQUAL ORDNERNAME ""))
	)
      (PROGN (SETQ WAHLPFAD_NEU
		    (K_PATHSLASH
		      (STRCAT WAHLPFAD_NEU "/" ORDNERNAME)
		      nil
		    )
	     )
	     (VL-MKDIR WAHLPFAD_NEU)
	     (K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
      )
    )
  )
  (DEFUN K_PFADWAHL_WAHLPFAD nil
    (SETQ WAHLPFAD     (K_TXT-SUBST (GET_TILE "wahlpfad") "\\" "/")
	  WAHLPFAD_NEU WAHLPFAD
    )
    (K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
  )
  (SETQ	DRIVE_LIST   (MAPCAR (QUOTE (LAMBDA (DUMMY) (NTH 0 DUMMY)))
			     (K_MK_DRIVES_LIST)
		     )
	WAHLPFAD     (IF WAHLPFAD
		       (K_TXT-SUBST WAHLPFAD "\\" "/")
		       ""
		     )
	WAHLPFAD_NEU WAHLPFAD
  )
  (IF (AND EXT_LIST (= (TYPE EXT_LIST) (QUOTE STR)))
    (SETQ EXT_LIST (LIST EXT_LIST))
  )
  (SETQ	K_PFADWAHL_DCL
	 (K_TEMP-DCL
	   (LIST "k_pfadwahl : dialog {"
		 "  label = \"Pfadwahl\";"
		 "  key = \"rahmen\";"
		 "  width = 150;"
		 "  : edit_box {"
		 "    key = \"wahlpfad\";"
		 "    label = \"\";"
		 "  }"
		 "  : boxed_row {"
		 "    height = 23;"
		 "    : column {"
		 "      : list_box {"
		 "        key = \"pfad_list\";"
		 "        fixed_width = true;"
		 "        width = 60;"
		 "        fixed_height = true;"
		 "        height = 20;"
		 (IF (AND MULTI EXT_LIST)
		   "        multiple_select = true;"
		   ""
		 )
		 "      }"
		 "      : popup_list {"
		 "        key = \"drive_list\";"
		 "        fixed_height = true;"
		 "        height = 3;"
		 "      }"
		 "    }"
		 "    : column {"
		 "      : list_box {"
		 "        key = \"file_list\";"
		 (IF (AND MULTI EXT_LIST)
		   "        multiple_select = true;"
		   ""
		 )
		 "        fixed_width = true;"
		 "        width = 90;"
		 "        fixed_height = true;"
		 "        height = 20;"
		 "      }"
		 "      : text {"
		 "        label = \"\";"
		 "        key = \"check_txt\";"
		 "        fixed_height = true;"
		 "        height = 3;"
		 "      }"
		 "    }"
		 "  }"
		 "  : row {"
		 "    : button {"
		 "      label = \"OK\";"
		 "      key = \"accept\";"
		 "      is_default = true;"
		 "    }"
		 "    : button {"
		 "      label = \"ABBRUCH\";"
		 "      key = \"cancel\";"
		 "      is_cancel = true;"
		 "    }"
		 "    : button {"
		 "      label = \"Check\";"
		 "      key = \"check\";"
		 "    }"
		 "    : button {"
		 "      label = \"Ordner anlegen\";"
		 "      key = \"ordner_neu\";"
		 "    }"
		 "  }"
		 "}"
		 "k_ok_cancel  : column {"
		 "  children_alignment = left;"
		 "  : row {"
		 "    fixed_width = true;"
		 "    : button {"
		 "      key = \"accept\";"
		 "      label = \"OK\";"
		 "      is_default = true;"
		 "      fixed_width = true;"
		 "    }"
		 "    : button {"
		 "      key = \"cancel\";"
		 "      label = \"Abbruch\";"
		 "      is_cancel = true;"
		 "      fixed_width = true;"
		 "    }"
		 "  }"
		 "}"
	   )
	 )
  )
  (SETQ K_PFADWAHL_ID (LOAD_DIALOG K_PFADWAHL_DCL))
  (VL-FILE-DELETE K_PFADWAHL_DCL)
  (IF (NOT (NEW_DIALOG "k_pfadwahl" K_PFADWAHL_ID))
    (EXIT)
  )
  (K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
  (START_LIST "drive_list")
  (MAPCAR (QUOTE ADD_LIST) DRIVE_LIST)
  (END_LIST)
  (IF (VL-POSITION (SUBSTR WAHLPFAD 1 2) DRIVE_LIST)
    (SET_TILE "drive_list"
	      (ITOA (VL-POSITION (SUBSTR WAHLPFAD 1 2) DRIVE_LIST))
    )
  )
  (IF EXT_LIST
    (PROGN (ACTION_TILE "file_list" "(k_pfadwahl_file_list)")
	   (ACTION_TILE "check" "(k_pfadwahl_check t)")
    )
    (PROGN (MODE_TILE "file_list" 1) (MODE_TILE "check" 1))
  )
  (IF TEXT
    (SET_TILE "rahmen" TEXT)
  )
  (ACTION_TILE "wahlpfad" "(k_pfadwahl_wahlpfad)")
  (ACTION_TILE "ordner_neu" "(k_pfadwahl_ordner_neu)")
  (ACTION_TILE "drive_list" "(k_pfadwahl_drive_list)")
  (ACTION_TILE "pfad_list" "(k_pfadwahl_pfad_list)")
  (ACTION_TILE "accept" "(k_end_pfadwahl 1)")
  (ACTION_TILE "cancel" "(k_end_pfadwahl 0)")
  (START_DIALOG)
  (UNLOAD_DIALOG K_PFADWAHL_ID)
  (IF (= K_PFADWAHL_OK 1)
    (IF	WAHLFILE_NEU_LIST
      (SETQ WERT (CONS WAHLPFAD_NEU WAHLFILE_NEU_LIST))
      (SETQ WERT WAHLPFAD_NEU)
    )
    (SETQ WERT nil)
  )
  WERT
)
(DEFUN K_PFADWAHL_ZUSAMMENBAUEN	(LISTE)
  (MAPCAR (QUOTE
	    (LAMBDA (NAME) (STRCAT (K_PATHSLASH (CAR LISTE) nil) NAME))
	  )
	  (CDR LISTE)
  )
)
(DEFUN K_PURGE_LIST (LISTE / DUMMY_LIST)
  (WHILE LISTE
    (SETQ DUMMY_LIST (CONS (CAR LISTE) DUMMY_LIST)
	  LISTE	     (VL-REMOVE (CAR LISTE) LISTE)
    )
  )
  (REVERSE DUMMY_LIST)
)
(DEFUN K_PUT_DATA_ACAD (OBJ_NAME      BEZ	    DATA
			/	      ATT_LIST	    BEZ_ZÄHLER
			DAT_LIST      DATA_LIST	    DYN_LIST
			OBJ	      PROP	    XDATA
			XTYPE	      XVALUE	    ZIEL_ATT
			K_COUNTER_DIALOG_NEU	    K_FIND_RAUM_CHK
			K_GET_DATA_WORK
		       )
  (SETQ BEZ_ZÄHLER 0)
  (IF (AND (= (TYPE BEZ) (QUOTE LIST)) DATA)
    (SETQ BEZ_ZÄHLER (NTH 1 BEZ)
	  BEZ	     (NTH 0 BEZ)
    )
    (SETQ BEZ_ZÄHLER 0)
  )
  (IF (AND (= (TYPE BEZ) (QUOTE LIST)) (NOT DATA))
    (SETQ BEZ_LIST  (MAPCAR (QUOTE CAR) BEZ)
	  DATA_LIST (MAPCAR (QUOTE CADR) BEZ)
    )
    (SETQ BEZ_LIST  (LIST BEZ)
	  DATA_LIST (LIST DATA)
    )
  )
  (SETQ OBJ_NAME (K_->OBJ_NAME OBJ_NAME))
  (MAPCAR
    (QUOTE
      (LAMBDA (BEZ DATA / DATA_LIST DAT_LIST)
	(IF BEZ
	  (IF (AND (vlax-property-available-p OBJ_NAME BEZ) DATA)
	    (PROGN
	      (IF
		(SETQ DAT (K_DATA->PROPERTY-CONVERT OBJ_NAME BEZ DATA))
		 (IF (VL-CATCH-ALL-ERROR-P
		       (VL-CATCH-ALL-APPLY
			 (QUOTE setpropertyvalue)
			 (LIST (K_->ENT_NAME OBJ_NAME) BEZ DAT)
		       )
		     )
		   (EVAL
		     (LIST (READ (STRCAT "vla-put-" BEZ)) OBJ_NAME DAT)
		   )
		 )
	      )
	    )
	    (IF
	      (AND (vlax-property-available-p OBJ_NAME "isdynamicblock")
		   (= (vla-get-IsDynamicBlock OBJ_NAME) :vlax-true)
		   (vlax-method-applicable-p
		     OBJ_NAME
		     (QUOTE GETDYNAMICBLOCKPROPERTIES)
		   )
		   (SETQ PROP
			  (CADR
			    (ASSOC
			      BEZ
			      (VL-REMOVE
				(QUOTE nil)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (PROP)
				      (IF
					(= (vla-get-Show PROP) :vlax-true)
					 (LIST (vla-get-PropertyName PROP)
					       PROP
					 )
				      )
				    )
				  )
				  (vlax-invoke
				    OBJ_NAME
				    (QUOTE GETDYNAMICBLOCKPROPERTIES)
				  )
				)
			      )
			    )
			  )
		   )
	      )
	       (K_DATA->PROP PROP DATA)
	       (IF
		 (AND (vlax-property-available-p OBJ_NAME "hasattributes")
		      (= (vla-get-HasAttributes OBJ_NAME) :vlax-true)
		      (ASSOC (STRCASE BEZ)
			     (SETQ ATT_LIST
				    (MAPCAR
				      (QUOTE
					(LAMBDA	(OBJ)
					  (LIST
					    (STRCASE (vla-get-TagString OBJ))
					    OBJ
					  )
					)
				      )
				      (vlax-invoke
					OBJ_NAME
					(QUOTE GETATTRIBUTES)
				      )
				    )
			     )
		      )
		 )
		  (IF (SETQ ZIEL_ATT
			     (NTH BEZ_ZÄHLER
				  (VL-REMOVE-IF-NOT
				    (QUOTE (LAMBDA (ATT_DATA)
					     (OR (= (NTH 0 ATT_DATA) BEZ)
						 (= (NTH 0 ATT_DATA)
						    (STRCASE BEZ)
						 )
					     )
					   )
				    )
				    ATT_LIST
				  )
			     )
		      )
		    (IF	DATA
		      (vla-put-TextString (NTH 1 ZIEL_ATT) DATA)
		      (vla-put-TextString (NTH 1 ZIEL_ATT) "")
		    )
		  )
	       )
	    )
	  )
	)
      )
    )
    BEZ_LIST
    DATA_LIST
  )
  (FOREACH V (QUOTE (OBJ_NAME BEZ	    DATA	  APP
			      ATT_LIST	    BEZ_ZÄHLER	  DAT_LIST
			      DATA_LIST	    DYN_LIST	  OBJ
			      PROP	    XDATA	  XTYPE
			      XVALUE	    ZIEL_ATT
			      K_COUNTER_DIALOG_NEU
			      K_FIND_RAUM_CHK
			      K_GET_DATA_WORK
			     )
	     )
    (SETQ V nil)
  )
  (PRINC)
)
(DEFUN K_P_TWIST (P PX WX / PZ PXZ)
  (SETQ	PZ  (CADDR P)
	PXZ (CADDR PX)
  )
  (SETQ	P  (K_3D->2D P)
	PX (K_3D->2D PX)
  )
  (VL-REMOVE (QUOTE nil)
	     (APPEND (POLAR PX (+ (ANGLE PX P) WX) (DISTANCE PX P))
		     (LIST PZ)
	     )
  )
)
(DEFUN K_REMOVE	(LISTE REMOVE_LIST)
  (IF (NOT (LISTP REMOVE_LIST))
    (SETQ REMOVE_LIST (LIST REMOVE_LIST))
  )
  (FOREACH REMOVE REMOVE_LIST
    (SETQ LISTE (VL-REMOVE REMOVE LISTE))
  )
)
(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 K_TEMP-DCL (DATA_LIST / PATH FILE)
  (COND	((SETQ FILE (OPEN (SETQ PATH (VL-FILENAME-MKTEMP "tmp~.dcl")) "w"))
	 (FOREACH ZEILE DATA_LIST (WRITE-LINE ZEILE FILE))
	 (CLOSE FILE)
	 PATH
	)
  )
)
(DEFUN K_TXT-SUBST (TXT ALT_LIST NEU_LIST)
  (IF (NOT (LISTP ALT_LIST))
    (SETQ ALT_LIST (LIST ALT_LIST))
  )
  (IF (NOT (LISTP NEU_LIST))
    (SETQ NEU_LIST (LIST NEU_LIST))
  )
  (WHILE (> (LENGTH ALT_LIST)
	    (MIN (LENGTH ALT_LIST) (LENGTH NEU_LIST))
	 )
    (SETQ ALT_LIST (I-CDR ALT_LIST))
  )
  (WHILE (> (LENGTH NEU_LIST)
	    (MIN (LENGTH ALT_LIST) (LENGTH NEU_LIST))
	 )
    (SETQ NEU_LIST (I-CDR NEU_LIST))
  )
  (MAPCAR
    (QUOTE
      (LAMBDA (ALT NEU)
	(WHILE
	  (NOT (EQUAL TXT (SETQ TXT (VL-STRING-SUBST NEU ALT TXT))))
	)
      )
    )
    ALT_LIST
    NEU_LIST
  )
  TXT
)
(DEFUN K_TXT_INPUT_1 (RAHMENTEXT BEZ TXT / K_TXT_INPUT_1_ID)
  (DEFUN K_END_TXT_INPUT_1 (WERT)
    (COND ((AND (= $REASON 1) (= WERT 2))
	   (SETQ TEMP_TXT (GET_TILE "txt_1"))
	   (DONE_DIALOG)
	  )
	  ((AND (= $REASON 1) (= WERT 1))
	   (SETQ TEMP_TXT (GET_TILE "txt_1"))
	   (DONE_DIALOG)
	  )
	  ((AND (= $REASON 1) (= WERT 0))
	   (SETQ TEMP_TXT TXT)
	   (DONE_DIALOG WERT)
	  )
	  ((AND (= $REASON 1) (= WERT 3)) (DONE_DIALOG WERT))
    )
  )
  (SETQ TEMP_TXT TXT)
  (SETQ K_TXT_INPUT_1_ID (LOAD_DIALOG "k_insimp.dcl"))
  (SETQ AKTION 4)
  (WHILE (< 2 AKTION)
    (IF	(NOT (NEW_DIALOG "k_txt_input_1" K_TXT_INPUT_1_ID))
      (EXIT)
    )
    (SET_TILE "rahmentext" RAHMENTEXT)
    (SET_TILE "bez_1" BEZ)
    (SET_TILE "txt_1"
	      (IF TEMP_TXT
		TEMP_TXT
		""
	      )
    )
    (MODE_TILE "txt_1" 2)
    (ACTION_TILE "objektwahl" "(k_end_txt_input_1 3)")
    (ACTION_TILE "txt_1" "(k_end_txt_input_1 2)")
    (ACTION_TILE "accept" "(k_end_txt_input_1 1)")
    (ACTION_TILE "cancel" "(k_end_txt_input_1 0)")
    (SETQ AKTION 3)
    (SETQ AKTION (START_DIALOG))
    (IF	(= AKTION 3)
      (IF (SETQ OBJ (K_->OBJ_NAME (CAR (NENTSEL))))
	(SETQ
	  TEMP_TXT (COND ((MEMBER (vla-get-ObjectName OBJ)
				  (QUOTE ("AcDbText"
					   "AcDbMText"
					   "AcDbAttribute"
					   "AcDbAttributeDefinition"
					 )
				  )
			  )
			  (vla-get-TextString OBJ)
			 )
			 (T "")
		   )
	)
      )
    )
  )
  (UNLOAD_DIALOG K_TXT_INPUT_1_ID)
  TEMP_TXT
)
(DEFUN K_VARIANT->VALUE	(VAR / VALUE)
  (IF (= (TYPE VAR) (QUOTE variant))
    (PROGN (SETQ VALUE (vlax-variant-value VAR))
	   (COND ((= (TYPE VALUE) (QUOTE safearray))
		  (IF (MINUSP (vlax-safearray-get-u-bound VALUE 1))
		    nil
		    (vlax-safearray->list VALUE)
		  )
		 )
		 (T VALUE)
	   )
    )
    VAR
  )
)
(DEFUN K_VL-SORT (LISTE SORTFUNCTION)
  (MAPCAR (QUOTE (LAMBDA (I) (NTH I LISTE)))
	  (VL-SORT-I (MAPCAR (QUOTE STRCASE)
			     (MAPCAR (QUOTE VL-PRINC-TO-STRING) LISTE)
		     )
		     SORTFUNCTION
	  )
  )
)
(DEFUN K_WCMATCH_POS (TEXT FILTER / START LISTE INC)
  (DEFUN K_WCMATCH_POS_WORK (TEXT / LISTE N TXT)
    (SETQ N (STRLEN TEXT))
    (WHILE (AND	(/= (SUBSTR TEXT 1 N) "")
		(WCMATCH (SUBSTR TEXT 1 N) FILTER)
	   )
      (SETQ N (1- N))
    )
    (SETQ TXT (SUBSTR TEXT 1 (1+ N))
	  N   1
    )
    (WHILE (AND (<= N (STRLEN TEXT)) (WCMATCH (SUBSTR TXT N) FILTER))
      (SETQ N (1+ N))
    )
    (SETQ START	(1- N)
	  INC	(+ INC START)
	  LISTE	(LIST (LIST INC (STRLEN (SUBSTR TXT START))))
	  INC	(+ INC (1- (STRLEN (SUBSTR TXT START))))
    )
    (IF	(AND (/= ""
		 (SETQ
		   TEXT	(SUBSTR TEXT (+ START (STRLEN (SUBSTR TXT START))))
		 )
	     )
	     (WCMATCH TEXT FILTER)
	)
      (SETQ LISTE (APPEND LISTE (K_WCMATCH_POS_WORK TEXT)))
    )
    LISTE
  )
  (IF (= (STRLEN TEXT) 0)
    (SETQ LISTE (LIST (LIST 1 0)))
    (IF	(= FILTER "*")
      (SETQ LISTE (LIST (LIST 1 (STRLEN TEXT))))
      (PROGN (SETQ INC 0)
	     (IF (WCMATCH TEXT FILTER)
	       (PROGN (SETQ LISTE (K_WCMATCH_POS_WORK TEXT)))
	     )
      )
    )
  )
  LISTE
)
(DEFUN K_WINKELDIFFERENZ_EFFEKTIV (W1 W2)
  (SETQ W1 (K_WINKEL_EFFEKTIV W1))
  (SETQ W2 (K_WINKEL_EFFEKTIV W2))
  (WHILE (< W2 W1) (SETQ W2 (+ W2 (* 2.0 PI))))
  (K_WINKEL_EFFEKTIV (- W2 W1))
)
(DEFUN K_WINKEL_EFFEKTIV (W)
  (WHILE (MINUSP W) (SETQ W (+ W (* 2.0 PI))))
  (REM (+ W (* 2.0 PI)) (* 2.0 PI))
)
(DEFUN K_ZAHLENREIHE (Z / N REIHE)
  (IF (> Z 0)
    (PROGN (SETQ REIHE (LIST (1- (FIX Z))))
	   (REPEAT (1- (FIX Z))
	     (SETQ REIHE (CONS (1- (CAR REIHE)) REIHE))
	   )
	   REIHE
    )
    nil
  )
)
(DEFUN K_ZAHLENREIHE_START (Z START)
  (MAPCAR (QUOTE (LAMBDA (N) (+ START N))) (K_ZAHLENREIHE Z))
)
(DEFUN K_ZAHLENREIHE_START_STEP	(Z START STEP)
  (MAPCAR (QUOTE (LAMBDA (N) (+ START (* STEP N))))
	  (K_ZAHLENREIHE_START Z 0)
  )
)
(DEFUN K_ZERLEGE_ART (ZEILE TRENNER ART / LISTE)
  (SETQ
    LISTE (VL-REMOVE ""
		     (K_ZERLEGE_TEXT ZEILE (STRCAT "*" TRENNER "*") 2)
	  )
  )
  (COND	((= ART "int") (SETQ LISTE (MAPCAR (QUOTE ATOI) LISTE)))
	((= ART "real") (SETQ LISTE (MAPCAR (QUOTE ATOF) LISTE)))
	((= ART "str") (SETQ LISTE LISTE))
	(T nil)
  )
  LISTE
)
(DEFUN K_ZERLEGE_TEXT (TEXT FILTER RÜCKGABE / TEIL)
  (COND
    ((= RÜCKGABE 0)
     (MAPCAR (QUOTE
	       (LAMBDA (TEIL) (SUBSTR TEXT (NTH 0 TEIL) (NTH 1 TEIL)))
	     )
	     (K_MK_SUBSTR_LIST TEXT FILTER T)
     )
    )
    ((= RÜCKGABE 1)
     (MAPCAR (QUOTE
	       (LAMBDA (TEIL) (SUBSTR TEXT (NTH 0 TEIL) (NTH 1 TEIL)))
	     )
	     (K_WCMATCH_POS TEXT FILTER)
     )
    )
    ((= RÜCKGABE 2)
     (MAPCAR (QUOTE
	       (LAMBDA (TEIL) (SUBSTR TEXT (NTH 0 TEIL) (NTH 1 TEIL)))
	     )
	     (K_MK_SUBSTR_LIST TEXT FILTER nil)
     )
    )
    ((= RÜCKGABE 3)
     (MAPCAR (QUOTE (LAMBDA (TEIL) (LIST (NTH 0 TEIL) (NTH 1 TEIL))))
	     (K_MK_SUBSTR_LIST TEXT FILTER T)
     )
    )
    ((= RÜCKGABE 4)
     (MAPCAR (QUOTE (LAMBDA (TEIL) (LIST (NTH 0 TEIL) (NTH 1 TEIL))))
	     (K_WCMATCH_POS TEXT FILTER)
     )
    )
    ((= RÜCKGABE 5)
     (MAPCAR (QUOTE (LAMBDA (TEIL) (LIST (NTH 0 TEIL) (NTH 1 TEIL))))
	     (K_MK_SUBSTR_LIST TEXT FILTER nil)
     )
    )
  )
)
(DEFUN L-2NDINHIBITION (L0 L1 / CMP L2)
  (SETQ L0 (VL-SORT (MAKE-SORTABLE L0) (QUOTE _<)))
  (SETQ L1 (VL-SORT (MAKE-SORTABLE L1) (QUOTE _<)))
  (WHILE (AND L0 L1)
    (SETQ CMP (COMPARE (CAR L0) (CAR L1)))
    (COND ((= CMP -1)
	   (SETQ L2 (CONS (CDAR L0) L2)
		 L0 (CDR L0)
	   )
	  )
	  ((= CMP 1) (SETQ L1 (CDR L1)))
	  ((QUOTE T)
	   (SETQ L0 (CDR L0)
		 L1 (CDR L1)
	   )
	  )
    )
  )
  (APPEND L2 (MAPCAR (QUOTE CDR) L0))
)
(DEFUN MAKE-SORTABLE (L /)
  (MAPCAR (QUOTE (LAMBDA (E /) (CONS (VL-PRIN1-TO-STRING E) E)))
	  L
  )
)
(DEFUN N-CAR (N LST / RES)
  (REPEAT (MIN N (LENGTH LST))
    (SETQ RES (CONS (CAR LST) RES)
	  LST (CDR LST)
    )
  )
  (REVERSE RES)
)
(DEFUN N-CDR (N LST) (REPEAT N (SETQ LST (CDR LST))))
(DEFUN _< (E0 E1 /) (< (CAR E0) (CAR E1)))

(defun c:k_insimp (/		ABSTAND	     ATT	  ATT-S
		   ATT_LIST	AUSWAHL	     AUSWAHL_LIST CHECK
		   CHECK_LIST	DATA	     DATA_LIST	  DUMMY
		   FELD		FELDER_LIST  FILES_LIST	  FILTER
		   FILTER-WERTE_LIST	     FILTER_DATA_LIST
		   FILTER_LIST	GROUP	     GROUP_LIST	  IMPORT_LIST
		   INS		INSERT_DUMMY INSIMP_ID	  INS_LIST
		   N		OBJ	     OBJ_LIST	  ODBX
		   OK		P	     PX		  SHOW_LIST
		   TEMP_FILTER_LIST	     WERT	  WERTE
		   WERTE_LIST
		  )

  (defun k_insimp_enddlg (wert)
    (setq ok wert)
    (done_dialog wert)
  )

  (defun k_insimp_felder ()
    (if	(= $reason 4)
      (progn
	(setq feld (nth (atoi (get_tile "felder_list")) felder_list))
	(if (not (member feld filter_list))
	  (progn
	    (setq filter_list (append filter_list (list feld)))
	    (start_list "filter_list")
	    (mapcar 'add_list filter_list)
	    (end_list)
	    (set_tile "filter_list"
		      (itoa (vl-position feld filter_list))
	    )
	    (k_insimp_filter)
	  )
	)
      )
    )
  )

  (defun k_insimp_filter ()
    (setq filter     (nth (atoi (get_tile "filter_list")) filter_list)
	  werte_list
		     (vl-sort
		       (k_purge_list
			 (vl-remove 'nil
				    (mapcar '(lambda (data) (cadr (assoc filter data)))
					    data_list
				    )
			 )
		       )
		       '<
		     )
    )
    (start_list "werte_list")
    (mapcar 'add_list werte_list)
    (end_list)
    (if	(assoc filter filter-werte_list)
      (set_tile
	"werte_list"
	(vl-string-trim
	  "()"
	  (vl-princ-to-string
	    (mapcar '(lambda (wert) (vl-position wert werte_list))
		    (cadr (assoc filter filter-werte_list))
	    )
	  )
	)
      )
    )
  )

  (defun k_insimp_werte	()
    (setq werte (k_get_tile_liste werte_list (get_tile "werte_list")))
    (cond
      ((and werte (not (assoc filter filter-werte_list)))
       (setq filter-werte_list
	      (cons (list filter werte) filter-werte_list)
       )
      )
      ((and werte (assoc filter filter-werte_list))
       (setq filter-werte_list
	      (cons (list filter werte)
		    (vl-remove (assoc filter filter-werte_list)
			       filter-werte_list
		    )
	      )
       )
      )
      ((and (not werte) (assoc filter filter-werte_list))
       (setq filter-werte_list
	      (vl-remove (assoc filter filter-werte_list)
			 filter-werte_list
	      )
       )
      )
    )
  )

  (vla-startundomark (k_ac-doc))
  (setq	files_list
	 (k_pfadwahl_zusammenbauen
	   (k_pfadwahl
	     (getvar "dwgprefix")
	     "Dateien wählen"
	     "*.dwg"
	     t
	     t
	   )
	 )
  )
;;; Dateien einlesen
  (setq	odbx	  (k_odbx_construct)
	show_list (mapcar 'vl-filename-base files_list)
  )
  (k_counter_liste "start" "Dateien" nil show_list)

  (foreach pfad	files_list
    (k_counter_liste
      "show"
      ""
      ""
      show_list
    )
    (setq show_list    (cdr show_list)
	  insert_dummy
		       (vla-insertblock
			 (vla-get-modelspace odbx)
			 (VLAX-3D-POINT '(0 0))
			 (findfile pfad)
			 1
			 1
			 1
			 0
		       )
    )
    (vla-explode insert_dummy)
    (vla-delete insert_dummy)
  )
  (k_counter_liste "end" "" nil nil)
  (setq	show_list '("Liste aller Objekte erstellen"
		    "Blöcke heraussortieren"
		    "Datenliste erstellen"
		    "Datenliste filtern nach auswahl"
		   )
  )
  (k_counter_liste "start" "Daten erfassen" nil show_list)

;;; Objektliste erstellen
  (k_counter_liste
    "show"
    ""
    ""
    show_list
  )
  (setq	show_list (cdr show_list)
	obj_list  (k_collection->list (vla-get-modelspace odbx))
  )

;;; Inserts herausfiltern
  (k_counter_liste
    "show"
    ""
    ""
    show_list
  )
  (setq	show_list (cdr show_list)
	obj_list  (vl-remove-if-not
		    '(lambda (obj)
		       (= (vla-get-objectname obj) "AcDbBlockReference")
		     )
		    obj_list
		  )
  )
;;; nur benannte Blöcke
  (setq	obj_list (vl-remove-if
		   '(lambda (obj)
		      (= (substr (vla-get-effectivename obj) 1 1) "*")
		    )
		   obj_list
		 )
  )
;;; Daten erfassen
  (k_counter_liste
    "show"
    ""
    ""
    show_list
  )
  (setq	show_list (cdr show_list)
	data_list
		  (mapcar
		    '(lambda (obj)
		       (append
			 (list (list "Objectname" obj)
			       (list "Blockname" (vla-get-effectivename obj))
			       (list "Layername" (vla-get-layer obj))
			 )
			 (mapcar '(lambda (data) (mapcar 'vl-princ-to-string data))
				 (k_get_data_acad
				   obj
				 )
			 )
		       )
		     )
		    obj_list
		  )
  )
;;; Ergebnisse filtern
  (k_counter_liste
    "show"
    ""
    ""
    show_list
  )
  (setq	show_list   (cdr show_list)
	felder_list
		    (append
		      '("Blockname" "Layername")
		      (vl-sort
			(k_remove
			  (k_purge_list
			    (mapcar 'car
				    (apply 'append data_list)
			    )
			  )
			  '("Objectname" "Blockname" "Layername")
			)
			'<
		      )
		    )
  )
  (k_counter_liste "end" "" nil nil)
;;; nach was soll gesucht werden ? Blöcke auf bestimmtem Layer, Blocknamen, Attributinhalte, usw.
;;; Dialog zum Daten filtern
;;; Feld wählen und Werte wählen
;;; Daten die nicht dem Filter entsprechen entfernen

  (setq insimp_id (load_dialog "k_insimp.dcl"))
  (if (not (new_dialog "k_insimp" insimp_id))
    (exit)
  )
  (start_list "felder_list")
  (mapcar 'add_list felder_list)
  (end_list)

  (action_tile "felder_list" "(k_insimp_felder)")
  (action_tile "filter_list" "(k_insimp_filter)")
  (action_tile "werte_list" "(k_insimp_werte)")

  (action_tile "accept" "(k_insimp_enddlg '1)")
  (action_tile "cancel" "(k_insimp_enddlg '0)")

  (start_dialog)
  (unload_dialog insimp_id)

  (if (= ok 1)
    (progn
;;; Filter auf Datenliste anwenden
      (setq filter_data_list data_list)
      (foreach filter filter-werte_list
	(setq temp_filter_list
			       (mapcar
				 '(lambda (dummy) (list (car filter) dummy))
				 (cadr filter)
			       )
	      filter_data_list
			       (vl-remove-if-not
				 '(lambda (data)
				    (member (assoc (car filter) data)
					    temp_filter_list
				    )
				  )
				 filter_data_list
			       )
	)
      )
;;; nach welchen Daten soll sortiert werden ? Diese Daten werden in die Inserts übernommen
;;; Daten gruppieren
;;; Felder wählen
      (setq auswahl_list
	     (k_auswahl_liste_sort
	       (append
		 '("Blockname" "Layername")
		 (vl-sort
		   (k_remove
		     (k_purge_list
		       (mapcar 'car
			       (apply 'append filter_data_list)
		       )
		     )
		     '("Objectname" "Blockname" "Layername")
		   )
		   '<
		 )
	       )
	     )
      )
;;; Daten gruppieren
      (foreach data filter_data_list
	(if (not
	      (member (vl-remove-if-not
			'(lambda (dat) (member (car dat) auswahl_list))
			data
		      )
		      check_list
	      )
	    )
	  (setq import_list (cons data import_list))
	)
	(setq check_list
	       (cons (vl-remove-if-not
		       '(lambda (dat) (member (car dat) auswahl_list))
		       data
		     )
		     check_list
	       )
	)
      )
      (setq n (length import_list))
;;; Definitionen importieren
      (foreach data import_list
	(vl-catch-all-error-p
	  (vl-catch-all-apply
	    'vlax-invoke
	    (list odbx
		  'CopyObjects
		  (list	(vla-item (vla-get-blocks odbx)
				  (cadr (assoc "Blockname" data))
			)
		  )
		  (vla-get-blocks
		    (k_ac-doc)
		  )
	    )
	  )
	)
      )
;;; Schichtweise sortieren
      (setq filter_data_list
			     (vl-remove
			       'nil
			       (mapcar '(lambda	(data)
					  (setq
					    check (mapcar '(lambda (auswahl)
							     (assoc auswahl data)
							   )
							  auswahl_list
						  )
					  )
					  (if (member check check_list)
					    nil
					    (progn (setq check_list
							  (cons check check_list)
						   )
						   data
					    )
					  )
					)
				       filter_data_list
			       )
			     )
	    group_list	     (list filter_data_list)
	    filter	     (nth 1 filter_list)
      )
      (foreach filter auswahl_list
	(setq group_list
	       (apply 'append
		      (mapcar '(lambda (group)
				 (setq group
					(vl-sort group
						 '(lambda (q1 q2)
						    (< (cadr (assoc filter q1))
						       (cadr (assoc filter q2))
						    )
						  )
					)
				 )
				 (k_group_assoc group filter)
			       )
			      group_list
		      )
	       )
	)
      )

      (setq group_list (apply 'append group_list))
;;; benötigte Layer importieren
      (foreach layername
	       (k_purge_list
		 (mapcar '(lambda (data) (cadr (assoc "Layername" data)))
			 group_list
		 )
	       )
	(vl-catch-all-error-p
	  (vl-catch-all-apply
	    'vlax-invoke
	    (list odbx
		  'CopyObjects
		  (list (vla-item (vla-get-layers odbx) layername))
		  (vla-get-layers
		    (k_ac-doc)
		  )
	    )
	  )
	)
      )
;;; dann einzeichnen
;;; Abstand festlegen
      (setq abstand (getdist "Abstand: "))
;;; Inserts einzeichnen und nur Daten aus Datengruppen zuweisen
      (setq p	     '(0 0)
	    ins_list nil
	    n	     (length group_list)
      )
      (k_counter_dialog "start" "Einzeichnen" nil)
      (foreach ins_data	group_list
	(k_counter_dialog
	  "show"
	  (cadr (assoc "Blockname" ins_data))
	  (setq n (1- n))
	)
	(setq ins (vla-insertblock
		    (vla-get-modelspace (k_ac-doc))
		    (VLAX-3D-POINT p)
		    (cadr (assoc "Blockname" ins_data))
		    1
		    1
		    1
		    0
		  )
	)
	(vla-put-layer ins (cadr (assoc "Layername" ins_data)))
	(foreach dummy (l-2ndinhibition
			 auswahl_list
			 '("Objectname" "Blockname" "Layername")
		       )
	  (k_put_data_acad ins dummy (cadr (assoc dummy ins_data)))
;;; keine Ahnung warum aber ACAD macht hier einen Fehler ins Objekt und deshalb werden hier die Attribute noch einmal mit ihren schon bestehenden Daten mit entmod bearbeitet.
;;; Es passiert eigentlich gar nichts, aber der Fehler ist weg
	  (foreach subobj (k_get_subobj ins)
	    (entmod subobj)
	  )
;;; nicht vergessen ... Attribute formatieren und positionieren. Daten dafür aus Quellobjekten holen
	  (setq	px	 (k_variant->value
			   (vla-get-insertionpoint
			     (cadr (assoc "Objectname" ins_data))
			   )
			 )
		att_list (mapcar '(lambda (att)
				    (list (vla-get-TagString att) att)
				  )
				 (k_get_atts ins)
			 )
	  )
	  (foreach att-q
		   (k_get_atts (cadr (assoc "Objectname" ins_data)))
	    (if	(setq att-s
		       (cadr (assoc (vla-get-TagString att-q) att_list))
		)
	      (progn
		(vla-put-height att-s (vla-get-height att-q))
		(vla-put-alignment att-s (vla-get-alignment att-q))
		(if (= 0 (vla-get-alignment att-q))
		  (vla-put-InsertionPoint
		    att-s
		    (VLAX-3D-POINT
		      (mapcar '+
			      (mapcar '-
				      (k_variant->value
					(vla-get-InsertionPoint att-q)
				      )
				      px
			      )
			      p
		      )
		    )
		  )
		  (vla-put-TextAlignmentPoint
		    att-s
		    (VLAX-3D-POINT
		      (mapcar
			'+
			(mapcar	'-
				(k_variant->value
				  (vla-get-TextAlignmentPoint att-q)
				)
				px
			)
			p
		      )
		    )
		  )
		)
	      )
	    )
	  )
	)
	(setq ins_list (cons ins ins_list)
	      p	       (mapcar '- p (list 0 abstand))
	)
      )
      (k_counter_dialog "end" nil nil)
;;;Positionieren der ganzen eingefügten Objekte
      (command "_move"
	       (k_objlist->satz ins_list)
	       ""
	       '(0 0)
	       pause
      )
    )
  )
  (vlax-release-object odbx)
  (vla-endundomark (k_ac-doc))
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_insimp:  Bauteillegende erstellen"
    "\n===========  "
    "\n(C) Andreas Kraus 2024 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_insimp\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)
