(Defun C:ZAHLEN ()
(START)
(setq STYLE_LIST
(EARX:LIST-TAB "STYLE")
STYLE_TAB (list)
FF (getvar "textstyle")
) ;_ end of setq
(if (or (null ff) (= ff " "))
(setq FF "STANDARD")
) ;_ end of if
(prompt "\nTextstil wählen ")
(princ STYLE_LIST)
(prompt (strcat " <" FF ">"))
(if (not (member (setq textst (strcase (getstring T))) STYLE_LIST)
) ;_ end of not
(setvar "textstyle" ff)
(setvar "textstyle" textst)
) ;_ end of if
(if (setq
texth (getreal
(strcat "\nTexthöhe <" (rtos (getvar "Textsize")) " >:")
) ;_ end of getreal
) ;_ end of setq
(setvar "Textsize" texth)
) ;_ end of if
(if (setq as
(getstring
"\nMöglicher Text vor PositionsNummer, oder Enter für keinen:"
) ;_ end of getstring
) ;_ end of setq
T
) ;_ end of if
(Setq A (Getint "\nStartnummer: "))
(Setq E 1)
(Setq I 0)
(Initget 1 "A")
(Setq P1T (Setq P1 (Getpoint "\nEinfuegepunkt oder Abbruch")))
(While (/= P1T "A")
(Setq F (Itoa A))
(if as
(setq F (strcat as f))
) ;_ end of if
(Command "_Text" "z" P1 "" I F)
(Setq A (+ A E))
(Initget 1 "A")
(Setq P1T (Setq P1 (Getpoint "\nEinfuegepunkt oder A für Abbruch")))
) ;_ end of While
(end)
(Princ)
) ;_ end of Defun
(defun *error* (em)
(end)
(princ "\nAbbruch : ")
(princ em)
) ;_ end of defun
(defun end ()
(if clay
(progn
(command "_-LAYER" "SE" clay "")
(setvar "BLIPMODE" bmod)
(setvar "CMDECHO" 1)
(setvar "MENUECHO" mech)
(setvar "OSMODE" mosm)
(setvar "SNAPMODE" msna)
(setvar "ORTHOMODE" mort)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun
(defun start ()
(setq bmod (getvar "BLIPMODE")
mosm (getvar "OSMODE")
msna (getvar "SNAPMODE")
mort (getvar "ORTHOMODE")
clay (getvar "CLAYER")
mech (getvar "MENUECHO")
) ;_ end of setq
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)
(setvar "MENUECHO" 3)
(setvar "OSMODE" 0)
(setvar "SNAPMODE" 0)
(setvar "ORTHOMODE" 0)
(command "_-LAYER" "M" "Pos" "Fa" "7" "" "")
) ;_ end of defun
(defun EARX:LIST-TAB
(TBL ; Zu bearbeitende Symboltabelle als Parameter
/ ; mitgegeben werden
EARX_DAT ; Gesamtliste des gefunden Eintrags der Layertabelle
EARX_NAM ; Namenseintrag
EARX_LIST ; Liste der Namenseinträge
)
(setq EARX_LIST nil) ; Alte Datenliste löschen
(setq EARX_DAT (tblnext TBL T)) ;Solange noch Einträge
(while EARX_DAT
(setq EARX_NAM (strcase (cdr (assoc 2 EARX_DAT))))
(setq EARX_LIST (cons EARX_NAM EARX_LIST))
(setq EARX_DAT (tblnext TBL))
) ;while
(setq EARX_LIST EARX_LIST)
) ;defun
(defun EARX:GET-VAL (KEY ELIST) (cdr (assoc KEY ELIST)))
------------------
Gruß
CADwiesel
Besucht uns im CHAT
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP