(defun k_get_temppfad ()
  (k_pathbackslash
		  (vl-filename-directory
		    (vl-filename-mktemp)
		  )
		  nil
		)
)

(defun k_pathbackslash (pfad remove)
;;; fügt einem pfad einen Backslash hinzu oder entfernt diesen
;;; außerdem werden alle Slashs in Backslashs konvertiert
  (if (and pfad (/= pfad ""))
    (progn
      (while
	(not
	  (equal pfad (setq pfad (vl-string-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_check-ltype (ent_data)
  (if
    (vl-some
      'null
      (mapcar
	'entget
	(mapcar	'cdr
		(vl-remove-if-not
		  '(lambda (dat) (= (car dat) 340))
		  ent_data
		)
	)
      )
    )
     (progn
       (setq sym nil
	     dummy_list1
	      nil
	     dummy_list2
	      nil
       )

       (foreach	dat ent_data
	 (cond
	   ((= (car dat) 75)
	    (setq sym t)
	    (setq dummy_list2 (list dat))
	   )
	   ((= (car dat) 49)
	    (setq sym nil)
	    (if	ok
	      (setq dummy_list1 (append dummy_list1 dummy_list2))
	    )
	    (setq dummy_list2 nil)
	    (setq dummy_list1 (append dummy_list1 (list dat)))
	   )
	   ((= (car dat) 340)
	    (if	(entget (cdr dat))
	      (setq ok t)
	      (setq ok nil)
	    )
	   )
	   (sym
	    (setq dummy_list2 (append dummy_list2 (list dat)))
	   )
	   ((null sym)
	    (setq dummy_list1 (append dummy_list1 (list dat)))
	   )
	 )
       )
       (if (assoc 340 dummy_list1)
	 (setq dummy_list1
		(subst '(74 . 4)
		       (assoc 74 dummy_list1)
		       dummy_list1
		)
	 )
	 (setq dummy_list1
		(subst '(74 . 0)
		       (assoc 74 dummy_list1)
		       dummy_list1
		)
	 )
       )
       (setq ent_data dummy_list1)
     )
  )
  ent_data
)

(defun mk_ltdat	(ent_data / n)
  (setq	zeile1 (strcat "*"
		       (cdr (assoc 2 ent_data))
		       ","
		       (cdr (assoc 3 ent_data))
	       )
  )
  (setq zeile2 "A")
  (setq anzahl (cdr (assoc 73 ent_data)))
  (setq gesamtl (cdr (assoc 40 ent_data)))
  (setq dummy_list ent_data)
  (repeat anzahl
    (setq dummy_list (member (assoc 49 dummy_list) dummy_list))
    (setq data_list (list (car dummy_list)))
    (setq n 1)
    (while (and	(< n (length dummy_list))
		(/= (car (nth n dummy_list)) 49)
	   )
      (setq data_list (cons (nth n dummy_list) data_list))
      (setq n (1+ n))
    )
    (setq data_list (reverse data_list))
    (setq laenge (cdr (assoc 49 data_list)))
    (setq komplex (cdr (assoc 74 data_list)))
    (cond
      ((= komplex 0)
       (setq zeile2 (strcat zeile2 "," (rtos (* laenge ltf_calc))))
      )
      ((= komplex 2)
       (if (null (assoc 340 data_list))
	 (setq data_list dummy_list)
       )
       (setq txt (cdr (assoc 9 data_list)))
       (if (entget (cdr (assoc 340 data_list)))
	 (setq
	   txtstil
	    (cdr (assoc 2 (entget (cdr (assoc 340 data_list)))))
	 )
       )
       (setq zeile2 (strcat zeile2 "," (rtos (* laenge ltf_calc))))
       (setq zeile2 (strcat zeile2 ",[\"" txt "\"," txtstil))
       (if (setq skal (assoc 46 data_list))
	 (setq
	   zeile2 (strcat zeile2 ",S=" (rtos (* (cdr skal) ltf_calc)))
	 )
       )
       (if (setq dreh (assoc 50 data_list))
	 (setq zeile2
		(strcat zeile2 ",R=" (rtos (* (/ (cdr dreh) pi) 180)))
	 )
       )
       (if (setq x_pos (assoc 44 data_list))
	 (setq zeile2
		(strcat zeile2 ",X=" (rtos (* (cdr x_pos) ltf_calc)))
	 )
       )
       (if (setq y_pos (assoc 45 data_list))
	 (setq zeile2
		(strcat zeile2 ",Y=" (rtos (* (cdr y_pos) ltf_calc)))
	 )
       )
       (setq zeile2 (strcat zeile2 "]"))
      )
      ((= komplex 4)
       (if (null (assoc 340 data_list))
	 (setq data_list dummy_list)
       )
       (setq sym_nr (cdr (assoc 75 data_list)))
       (if (entget (cdr (assoc 340 data_list)))
	 (setq
	   txtstil
	    (cdr (assoc 2 (entget (cdr (assoc 340 data_list)))))
	 )
       )
       (if (entget (cdr (assoc 340 data_list)))
	 (setq shx_datname
		(cdr (assoc 3 (entget (cdr (assoc 340 data_list))))
		)
	 )
       )
       (if (/= txtstil "")
	 (progn
	   (setq shx_datname
		  (cdr
		    (assoc 3
			   (entget (tblobjname "STYLE" txtstil))
		    )
		  )
	   )
	 )
       )
       (setq pos 1)
       (while (and (< pos (strlen shx_datname))
		   (/= (substr shx_datname pos 1) ".")
	      )
	 (setq pos (1+ pos))
       )
       (setq shp_datname (strcat (substr shx_datname 1 pos) "shp"))
       (if (findfile shp_datname)
	 (progn
	   (if (not (findfile shx_datname))
	     (progn
	       (setvar "filedia" 0)
	       (command "kmpilier" (findfile shp_name))
	       (k_pause 500)
	     )
	   )
	 )
       )
       (if (findfile shx_datname)
	 (progn
	   (setq stildatname shx_datname)
	   (if (null loaded_sym_list)
	     (setq loaded_sym_list (mk_loaded_sym_list))
	   )
	   (setq sym_name
		  (cdr
		    (assoc sym_nr
			   (cdr (assoc stildatname loaded_sym_list))
		    )
		  )
	   )
	   (if (null sym_name)
	     (progn
	       (foreach	data (cdr (assoc stildatname loaded_sym_list))
		 (if (equal (car data) sym_nr)
		   (setq sym_name (cdr data))
		 )
	       )
	     )
	   )
	 )
       )
       (setq zeile2 (strcat zeile2 "," (rtos (* laenge ltf_calc))))
       (if (and sym_name stildatname)
	 (setq zeile2 (strcat zeile2 ",[" sym_name "," stildatname))
	 (setq zeile2 (strcat zeile2 ",[" ","))
       )
       (if (setq skal (assoc 46 data_list))
	 (setq
	   zeile2 (strcat zeile2 ",S=" (rtos (* (cdr skal) ltf_calc)))
	 )
       )
       (if (setq dreh (assoc 50 data_list))
	 (setq zeile2
		(strcat zeile2 ",R=" (rtos (* (/ (cdr dreh) pi) 180)))
	 )
       )
       (if (setq x_pos (assoc 44 data_list))
	 (setq zeile2
		(strcat zeile2 ",X=" (rtos (* (cdr x_pos) ltf_calc)))
	 )
       )
       (if (setq y_pos (assoc 45 data_list))
	 (setq zeile2
		(strcat zeile2 ",Y=" (rtos (* (cdr y_pos) ltf_calc)))
	 )
       )
       (setq zeile2 (strcat zeile2 "]"))
      )
    )
    (setq dummy_list (cdr dummy_list))
  )
;;; (print zeile1)
;;; (print zeile2)
;;; (print "--------------------")
  (if (> anzahl 0)
    (progn
      (setq zeile2_list (k_zerlege_art zeile2 "`," "str"))
      (if (minusp (atof (nth 1 zeile2_list)))
	(progn
	  (setq	zeile2_list
		 (append (list (nth 0 zeile2_list))
			 (cddr zeile2_list)
			 (list (nth 1 zeile2_list))
		 )
	  )
	  (setq zeile2 "")
	  (mapcar
	    '(lambda (dummy) (setq zeile2 (strcat zeile2 "," dummy)))
	    zeile2_list
	  )
	  (setq zeile2 (substr zeile2 2))
	)
      )
      (setq tempdatlist (cons zeile2 tempdatlist))
      (setq tempdatlist (cons zeile1 tempdatlist))
    )
  )
)

(defun k_zerlege_art (zeile trenner art / liste)
;;; Text in Liste zerlegen
  (setq
    liste (vl-remove ""
		     (k_zerlege_text zeile (strcat "*" trenner "*") 2)
	  )
  )
  (cond
    ((= art "int")
     (setq liste (mapcar 'atoi liste))
    )
    ((= art "real")
     (setq liste (mapcar 'atof liste))
    )
    ((= art "str")
     (setq liste liste)
    )
    (t nil)
  )
  liste
)

(defun k_zerlege_text (text filter rückgabe / teil)

;;; sucht alle kleinstmöglichen Teilstrings auf die der Suchfilter noch zutrifft,
;;; zerlegt den String an diesen Stellen
;;; gibt eine Liste mit Teilstrings zurück
;;;
;;; Die mit dem Suchfilter gefundenen Teilstrings werden bei:
;;; - rückgabe=0 nicht entfernt
;;; - rückgabe=1 zurückgegeben
;;; - rückgabe=2 entfernt
;;; - rückgabe=3 Daten für Befehl substr entsprechend rückgabe 0
;;; - rückgabe=4 Daten für Befehl substr entsprechend rückgabe 1
;;; - rückgabe=5 Daten für Befehl substr entsprechend rückgabe 2
;;;
;;; Die Teilstrings werden durch eine Suchmuster ermittelt dessen Aufbau unter "wcmatch" nachzulesen ist
;;; Beispiele für filter
;;;   (setq filter "*#`.#*")
;;;   (setq filter "*[~0-9]*")
;;;   (setq filter "*[~0123456789`,]*")
;;;   (setq filter "*#`.?*")
;;;   (setq filter "*`,#*")
;;;
;;; benötigt werden die Unterfunktionen : k_mk_substr_list, k_wcmatch_pos

  (cond
    ((= rückgabe 0)
     (mapcar '(lambda (teil) (substr text (nth 0 teil) (nth 1 teil)))
	     (k_mk_substr_list text filter t)
     )
    )
    ((= rückgabe 1)
     (mapcar '(lambda (teil) (substr text (nth 0 teil) (nth 1 teil)))
	     (k_wcmatch_pos text filter)
     )
    )
    ((= rückgabe 2)
     (mapcar '(lambda (teil) (substr text (nth 0 teil) (nth 1 teil)))
	     (k_mk_substr_list text filter nil)
     )
    )
    ((= rückgabe 3)
     (mapcar '(lambda (teil) (list (nth 0 teil) (nth 1 teil)))
	     (k_mk_substr_list text filter t)
     )
    )
    ((= rückgabe 4)
     (mapcar '(lambda (teil) (list (nth 0 teil) (nth 1 teil)))
	     (k_wcmatch_pos text filter)
     )
    )
    ((= rückgabe 5)
     (mapcar '(lambda (teil) (list (nth 0 teil) (nth 1 teil)))
	     (k_mk_substr_list text filter nil)
     )
    )
  )
)

(defun k_mk_substr_list
       (text filter entf / f_list ergebnis_list pos start)
;;; sucht alle kleinstmöglichen Teilstrings auf die der Suchfilter noch zutrifft,
;;; gibt eine Liste mit Listen zurück die die Werte für substr enthalten
;;; Die mit dem Suchfilter gefundenen Teilstrings werden je nach "entf" entfernt
;;; benötigt wird die Unterfunktionen : k_wcmatch_pos

  (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
	'(lambda (dummy) (= (cadr dummy) 0))
	(reverse ergebnis_list)
      )
    )
    '((1 nil))
  )
)

(defun k_wcmatch_pos (text filter / start liste inc)
;;; sucht alle kleinstmöglichen Teilstrings auf die der Suchfilter noch zutrifft,
;;; gibt eine Liste mit Listen zurück die die Werte für substr enthalten
;;; In der Rückgabeliste sind nur die Werte für die mit dem Suchfilter gefundenen Teilstrings enthalten

  (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 mk_loaded_sym_list (/	       sym_nr	   dummy
			   dummy1      dummy_list  dummy_list1
			   dummy_list2 dummy_list3 log_list
			   datei       ok
			  )
  (setvar "cmdecho" 0)
  (print "suche geladene Symbole in Symboldateien")
  (print)
  (setq mem_logfilemode (getvar "logfilemode"))
  (setvar "logfilemode" 1)
  (setvar "cmdecho" 1)
  (command "_.SHAPE" "?" "*")
  (setvar "cmdecho" 0)
  (setvar "logfilemode" mem_logfilemode)
  (setq log_list (list))
  (k_pause 200)
  (setq datei (open (getvar "logfilename") "r"))
  (while (setq zeile (read-line datei))
    (setq log_list (cons zeile log_list))
  )
  (close datei)
  (if (= mem_logfilemode 0)
    (vl-file-delete (getvar "logfilename"))
  )
  (setq mem_logfilemode nil)
  (setq dummy_list (list))
  (setq ok t)
  (foreach log_	log_list
    (if	(equal log_ "Zur Verfügung stehende Symbole:")
      (setq ok nil)
    )
    (if	ok
      (setq dummy_list (cons log_ dummy_list))
    )
  )
  (setq loaded_sym_list (list))
  (setq dummy_list1 (list))
  (setq dummy_list2 (list))
  (setq ok t)

  (setq zeilen_list (vl-remove "" dummy_list))
  (setq	file_pos_list
	 (mapcar
	   '(lambda (dummy) (vl-position dummy zeilen_list))
	   (vl-remove-if-not
	     '(lambda (zeile) (wcmatch zeile "Datei:*"))
	     zeilen_list
	   )
	 )
  )
  (setq n 0)
  (foreach dummy zeilen_list
    (if	(member n file_pos_list)
      (progn
	(setq dummy_list1 (cons dummy_list dummy_list1))
	(setq dummy_list nil)
      )
      (setq dummy_list (cons dummy dummy_list))
    )
  )

  (setq	loaded_sym_list
	 (mapcar
	   '(lambda (file_data)
	      (setq
		file_data (vl-remove-if
			    '(lambda (zeile)
			       (or (equal zeile "")
				   (or (wcmatch zeile "Befehl:*")
				       (wcmatch zeile "(*")
				   )
			       )
			     )
			    file_data
			  )
	      )
	      (setq file (vl-string-trim
			   " "
			   (substr (nth 0 file_data) 7)
			 )
	      )
	      (setq data
		     (cons
		       file
		       (vl-remove
			 ""
			 (apply
			   'append
			   (mapcar
			     '(lambda (zeile)
				(k_zerlege_art zeile " " "str")
			      )
			     (cdr file_data)
			   )
			 )
		       )
		     )
	      )
	    )
	   (vl-remove 'nil dummy_list1)
	 )
  )

  (setq n 0)
  (while (tblsearch "LTYPE"
		    (setq temp_name (strcat "TEMP" (itoa n)))
	 )
    (setq n (1+ n))
  )
  (setvar "cmdecho" 0)
  (setq dummy_list (list))

  (foreach dummy loaded_sym_list
    (setq dummy_list1 (list))
    (setq symfile (nth 0 dummy))
    (setq dummy_list1 (cons symfile dummy_list1))
    (setq temp_pfad
	   (k_pathbackslash (k_get_temppfad) nil)
    )
    (foreach sym (cdr dummy)
      (setq zeile_temp (strcat "A,1,-1,[" sym "," symfile "],-1,1"))
      (setq datei (open (strcat temp_pfad "temp.lin") "w"))
      (write-line
	(strcat "*" (strcase temp_name) "," temp_name " -")
	datei
      )
      (write-line zeile_temp datei)
      (close datei)
      (k_pause 100)
      (print sym)
      (command "_.LINETYPE"
	       "_l"
	       temp_name
	       (strcat temp_pfad "temp.lin")
	       ""
      )
      (k_pause 100)
      (setq ent_name (tblobjname "LTYPE" temp_name))
      (setq ent_data (entget ent_name))
      (setq sym_nr (cdr (assoc 75 ent_data)))
      (setq dummy_list1 (cons (cons sym_nr sym) dummy_list1))
      (command "_.purge" "_lt" temp_name "_n")
    )
    (setq dummy_list (cons (reverse dummy_list1) dummy_list))
  )
  (setq loaded_sym_list (reverse dummy_list))
)

(defun k_pause (zeit)
;;; Wartezeit in Millisekunden
  (setq start (+ (getvar "date") (/ zeit 100000000.0)))
  (while
    (< (getvar "date") start)
  )
)

(defun c:ltfscale	(/ ltf_neu)
;;; Setzt einen neuen Linientypfaktor und rechnet alle Linientypdefinitionen auf den neuen Faktor um
  (setq	ltf_neu	(getreal
		  (strcat "neuer LT-Faktor <"
			  (rtos (getvar "ltscale"))
			  "> "
		  )
		)
  )
  (_ltfscale ltf_neu)
  (princ)
)

(defun _ltfscale (ltf_neu / n def)
;;;  (setq sympath_list (k_mk_sympath_list))
  (setq temp_pfad (k_get_temppfad))
  (setq ltf_calc (/ (getvar "ltscale") ltf_neu))
  (setq tempdatlist (list))
;;; (setq def (tblnext "LTYPE" t))
  (setq mem_luprec (getvar "luprec"))
  (setvar "luprec" 8)
  (while (setq def (tblnext "LTYPE" (null def)))
    (setq name (strcase (cdr (assoc 2 def))))
    (setq neuname "")
    (setq n 1)
    (repeat (strlen name)
      (if (/= (substr name n 1) "|")
	(setq neuname (strcat neuname (substr name n 1)))
	(setq neuname (strcat neuname "_"))
      )
      (setq n (1+ n))
    )
    (if	(not (equal name neuname))
      (progn
	(setq ent_name (tblobjname "LTYPE" name))
	(setq ent_data (entget ent_name))
	(setq ent_data
	       (subst (cons 2 neuname) (assoc 2 ent_data) ent_data)
	)
	(entmod ent_data)
	(setq name neuname)
      )
    )
    (if	(tblobjname "LTYPE" name)
      (if (and (not (wcmatch name "*CONTINUOUS"))
	       (not (wcmatch name "*AUSGEZOGEN"))
	  )
	(progn
	  (setq ent_name (tblobjname "LTYPE" name))
	  (setq ent_data (k_check-ltype (entget ent_name)))
	  (print
	    (strcat (cdr (assoc 2 ent_data)) " wird neu definiert")
	  )
	  (mk_ltdat ent_data)
	)
      )
      (print
	"XREF abhängige Linientypen können nicht konvertiert werden"
      )
    )
;;;   (setq def (tblnext "LTYPE"))
  )
  (if tempdatlist
    (progn
      (setq datei (open (strcat temp_pfad "temp.lin") "w"))
      (foreach zeile tempdatlist
	(write-line zeile datei)
      )
      (close datei)
      (k_pause 100)
      (setq name_list (list))
      (setq stellen 0)
      (setq datei (open (strcat temp_pfad "temp.lin") "r"))
      (while (setq zeile (read-line datei))
	(if (= (substr zeile 1 1) "*")
	  (progn
	    (setq n 2)
	    (while
	      (and (/= (substr zeile n 1) ",") (<= n (strlen zeile)))
	       (setq n (1+ n))
	    )
	    (setq name (substr zeile 2 (- n 2)))
	    (setq stellen (max stellen (strlen name)))
	    (setq name_list (cons name name_list))
	  )
	)
      )
      (close datei)
      (k_pause 100)
      (setvar "cmdecho" 0)
      (setvar "filedia" 0)
      (foreach name (acad_strlsort name_list)
	(if (tblsearch "LTYPE" name)
	  (command "_.LINETYPE"
		   "_l"
		   name
		   (strcat temp_pfad "temp.lin")
		   "_y"
		   ""
	  )
	  (command "_.LINETYPE"
		   "_l"
		   name
		   (strcat temp_pfad "temp.lin")
		   ""
	  )
	)
;;;	(while (> (getvar "cmdactive") 0) (command ""))
	(setq leerstellen "")
	(repeat	(- stellen (strlen name))
	  (setq leerstellen (strcat " " leerstellen))
	)
	(princ (strcat leerstellen name " neugeladen"))
      )
      (if (equal ltf_calc 1.0)
	(progn
	  (vl-file-copy
	    (strcat temp_pfad "temp.lin")
	    (strcat (getvar "dwgprefix") "temp.lin")
	  )
	  (print (strcat "Definitionsdatei in Ordner "
			 (getvar "dwgprefix")
			 " kopiert"
		 )
	  )
	)
      )
;;;     (command "shell" (strcat "del " temp_pfad "temp.lin"))
    )
  )
  (setvar "ltscale" ltf_neu)
  (setvar "luprec" mem_luprec)
  (setvar "filedia" 1)
  (setvar "cmdecho" 1)
)