143 lines
5.4 KiB
Common Lisp
143 lines
5.4 KiB
Common Lisp
;----------------------------------
|
|
;ko - Schriftfeld einf�gen
|
|
;ko2 - Masstab festlegen
|
|
;-------------------------------Genius-interne Funktionen:
|
|
;stab2 - Rahmengr”sse festlegen
|
|
;stab1 - Masstabkontrollieren auf richtiges format
|
|
;-----------------------------------verwendete Funktionen:
|
|
;--------------------------------------------Verkn�pfung:
|
|
;ko >stab1
|
|
; >stab2
|
|
;------------------------------------------Globalvariable:
|
|
;g_f,g_g
|
|
;g_st - vorschlag f�r 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 einf�gepunkts f�r 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 f�r Genius-vermassung
|
|
; sb-1 : masstab (zb 1:1)
|
|
(setvar "cmdecho" 0)
|
|
(setq *error* g_er)
|
|
(prompt "\nMasstab f�r 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 f�r 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 f�r Genius-vermassung
|
|
; sb-1 : masstab (zb 1:1)
|
|
; sb-2 : format (zb A1)
|
|
; sb-3 : vorgabe f�r 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
|
|
"EINF�GE" sb-3 p g_f g_f 0
|
|
"EINF�GE" (strcat "din" sb-2) "0,0" g_f g_f 0)
|
|
(if (/= nil sb-9)(command "EINF�GE" "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)
|
|
;einf�gen 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 "EINF�GE" "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)
|
|
|