;----------------------------------
;ko	- Schriftfeld einfgen
;ko2	- Masstab festlegen
;-------------------------------Genius-interne Funktionen:
;stab2	- Rahmengr”sse festlegen
;stab1	- Masstabkontrollieren auf richtiges format
;-----------------------------------verwendete Funktionen:
;--------------------------------------------Verknpfung:
;ko	>stab1
;		>stab2
;------------------------------------------Globalvariable:
;g_f,g_g
;g_st - vorschlag fr Firmenlogo (acad)
;--------------------------------------verwendete Bl”cke:
;din999	- Schriftfeld
;dina0 ... dina4 - Blattrahmen
;-------------------------------------Unterfunktionen
;g_ky	(dingen)
;g_in (dingen)
;-------------------------------------Version: 26.3.89
;-------------------------------------------------stab2
(prompt "\nLaden des Schriftfeldes.......... (c) Sch”nenberger Systeme GmbH       ")
;-------------------------------------------------stab1
(defun g-stab1 (sb-1 / )
(setvar "userr2" g_f)
(command "BEM" "BEMFKTR" g_f "EXIT" 
	"LTFAKTOR" g_f
))
;-----------------------------stab2 rahmen berehcnen
(defun g-stab2 (sb-2 / )
;umrechnen des einfgepunkts fr schriftfeld
(cond
;voll sollmass wird 10 abgezogen
;dina4 ausnahme wegen laserdrucker einfacher Rahmen
((= sb-2 "A4")(setq p (list (* g_f 190)(* g_f 0)) 
		pp (list (* g_f 210)(* g_f 297))))
((= sb-2 "A3")(setq p (list (* g_f 410)(* g_f 10))
		pp (list (* g_f 420)(* g_f 297))))
((= sb-2 "A2")(setq p (list (* g_f 584)(* g_f 10))
		pp (list (* g_f 594)(* g_f 420))))
((= sb-2 "A1")(setq p (list (* g_f 830)(* g_f 10))
		pp (list (* g_f 840)(* g_f 594))))
((= sb-2 "A0")(setq p (list (* g_f 1178)(* g_f 10))
		pp (list (* g_f 1188)(* g_f 840))))
)
)
;---------------------------------------festlegen der ausschnitte
(defun g-stab3  (p2o / p1o p2u pm pm1 pm2)
;bereich vierteln
(setq p1o (list 0 (nth 1 p2o)) 
      p2u (list (nth 0 p2o) 0)
      pm (list (* 0.5 (nth 0 p2o)) (* 0.5 (nth 1 p2o)))
      pm1 (list (* 0.25 (nth 0 p2o)) (* 0.25 (nth 1 p2o)))
      pm2 (list (* 0.75 (nth 0 p2o)) (* 0.75 (nth 1 p2o)))
)
(command "AUSSCHNT" "F" "1" p1o pm
	 "AUSSCHNT" "F" "2" pm p2o
	 "AUSSCHNT" "F" "3" '(0 0) pm
	 "AUSSCHNT" "F" "4" pm p2u
	 "AUSSCHNT" "F" "5" pm1 pm2)
)
;-------------------------------------------------C:ko2
(DEFUN C:g-ko2( / sb-6 sb-7 sb-1)
;einlesen des masstabs
; g_f : bergeordnerter Masstab fr Genius-vermassung
; sb-1 : masstab (zb 1:1)
(setvar "cmdecho" 0)
(setq *error* g_er)
(prompt "\nMasstab fr Einzelheit (Masstabsfaktor angepasst, Schriftgr”sse const.)")
(setq sb-6 '(50.0 20.0 10.0 5.0 2.0 1.0 0.5 0.2 0.1 0.05 0.02 0.01 0.005 0.002 0.001 0.0005 0.0002 0.0001 0.00005 0.00002 0.00001)
	sb-7 '("50:1" "20:1" "10:1" "5:1" "2:1" "1:1" "1:2" "1:5" "1:10" "1:20" "1:50" "1:100" "1:200" "1:500" "1:1000" "1:2000" "1:5000" "1:10000")
	sb-1 (g_ky sb-1 "\nMasstab fr Einzelheit:" "5:1"
	"50:1 20:1 10:1 5:1 2:1 1:1 1:2 1:5 1:10 1:20 1:50 1:100 1:200 1:500 1:1000 1:2000 1:5000 1:10000"
))
(setq g_g (/ 1.0 (nth (- (length sb-7) (length (member sb-1 sb-7))) sb-6)))
(command "BEM" "BEMGFLA" g_g "EXIT") 
)

;-------------------------------------------------ko
(DEFUN g-ko (sb-1 sb-2 sb-9 / sb-3 sb-4 sb-5 sb-6 sb-7 sb-8)
; g_f : bergeordnerter Masstab fr Genius-vermassung
; sb-1 : masstab (zb 1:1)
; sb-2 : format (zb A1)
; sb-3 : vorgabe fr logozeichnung, wird in acad.lsp definiert g_st
(setvar "cmdecho" 0)(setvar "regenmode" 0)
(setq *error* g_er
	sb-3 (g_in g_st "\nFirmensymbol " g_st) sb-8 nil)
;auswahl des formats
(while (/= sb-8 "J")
(setq sb-2 (g_ky sb-2 "Zeichenformat (A0 A1 A2 A3 A4):" "A3" "A4 A3 A2 A1 A0")
	g_f 1)
(g-stab2 sb-2); pp enthŽlt gr”ssen
(setq sb-6 '(50.0 20.0 10.0 5.0 2.0 1.0 0.5 0.2 0.1 0.05 0.02 0.01 0.005 0.002 0.001 0.0005 0.0002 0.0001 0.00005 0.00002 0.00001)
	sb-7 '("50:1" "20:1" "10:1" "5:1" "2:1" "1:1" "1:2" "1:5" "1:10" "1:20" "1:50" "1:100" "1:200" "1:500" "1:1000" "1:2000" "1:5000" "1:10000")
	sb-1 (g_ky sb-1 "Masstab Plot:Zeicheneinheiten (?/x:x)" "?"
	"? 50:1 20:1 10:1 5:1 2:1 1:1 1:2 1:5 1:10 1:20 1:50 1:100 1:200 1:500 1:1000 1:2000 1:5000 1:10000"
))
(if (= sb-1 "?")(progn
;bei fragezeichen ausrechnen format bekannt
(setq sb-4 (getdist "Max. Breite:")
	sb-5 (getdist "\nMax. H”he:")
	fak1 (min (/ (car pp) sb-4 ) (/ (nth 1 pp) sb-5)) cnt 0)
(while (and (/= (nth cnt sb-6) nil)(> (nth cnt sb-6) fak1))(setq cnt (+ cnt 1)))
(setq g_f (/ 1.0 (nth cnt sb-6))
   sb-1 (nth cnt sb-7)
)))
(prompt (strcat "\nFormat: " sb-2 "  Masstab: " sb-1))
(setq sb-8 (g_ky sb-8 "\nEingabe ok (J/N)" "J" "J N"))
)
;belegen von g_f suchen des elements
(setq g_f (/ 1.0 (nth (- (length sb-7) (length (member sb-1 sb-7))) sb-6)))
(g-stab1 sb-1)
(g-stab2 sb-2)
(g-stab3 pp)
(setvar "attdia" 1)
(command "LIMITEN" "0,0" pp 
	"EINFGE" sb-3 p g_f g_f 0
         "EINFGE" (strcat "din" sb-2) "0,0" g_f g_f 0)
(if (/= nil sb-9)(command "EINFGE" "din999" p g_f g_f 0))
;rest nach funktion abfrage durch attribute des blocks din999 definiert
(princ)
)
;----------------------------einlesend der schriftfeldes
(defun c:g-dabase ( / tx1 tx2 tx )
(g_sv)
;einfgen von datein temp.$$K mit schriftfeld
(setq datnr (open "temp.$$K" "r"))
(if (= datnr nil)(progn(prompt "Error: Datei nicht gefunden !")(quit)))
;erstes datei feld masstab, zweites din-Gr”sse
(setq tx1 (read-line datnr) tx2 (read-line datnr))
(g-ko tx1 tx2 nil)
;1.attribut suchen 
(setvar "attdia" 0)
(command "EINFGE" "din999" p g_f g_f 0)
(setvar "attdia" 1)
(while (/= nil (setq tx (read-line datnr)))(command tx))
(close datnr)(setq datnr nil)
(princ)
)


(princ)
