(defun c:CountBlocks (/ ans ss ss1 llist CurLay CurEnt i CurBlk CurBlkLst CurBlkEG CurAtt CurAttEG fp MstrBlkLst MstrIndx AttTgLst ) (if (/= _p0$ "COUNTBLOCKS") (def-cb) ) ;_ end of if (defun lc_QryUsr (/ stop stop1 ans ans1 fp) (while (not stop) (initget _p2$) (setq ans (getkword _p3$)) (cond ((or (not ans) (= _p4$ ans) (= _p5$ ans)) (setq stop t)) ((= _p6$ ans) (setq ans (getstring _p7$)) (if (= ans "") (princ _p8$) (if (not (setq fp (open ans "r"))) (princ (strcat _p9$ ans _p10$)) (progn (close fp) (command _p11$ (strcat "copy " ans "+temp.ez " ans " > delete.me") ) ;_ end of command (princ (strcat _p12$ (findfile ans) _p13$)) ) ;_ end of progn ) ;_ end of if ) ;_ end of if ) ((= _p14$ ans) (setq ans (getstring _p15$)) (if (= ans "") (princ _p8$) (progn (setq stop1 nil) (while (and (not stop1) (setq fp (open ans "r")) ) ;_ end of and (close fp) (initget _p16$) (setq ans1 (getkword (strcat _p17$ ans _p18$))) (if (and ans1 (= ans1 _p19$) ) ;_ end of and (setq stop1 t) (setq ans (getstring _p15$)) ) ;_ end of if ) ;_ end of while (command _p11$ (strcat "copy temp.ez " ans " > delete.me")) (if (findfile ans) (princ (strcat _p12$ (findfile ans) _p20$)) ) ;_ end of if ) ;_ end of progn ) ;_ end of if ) ((= _p21$ ans) (setq _AutoIns T) (leave) (drawtext) (enter (+ 1)) (def-cb) ) ) ;_ end of cond ) ;_ end of while ) ;_ end of defun (defun lc_BldAttLst (CurBlkLst / i j CurAttLst CurAttTag stop ATLI) (if (/= 'LIST (type CurBlkLst)) (princ "\nERROR(lc_BldAttLst): argument given must be a list" ) ;_ end of princ (if (= '1 (length CurBlkLst)) (princ "\nERROR(lc_BldAttLst): given list must contain more than one element" ) ;_ end of princ (progn (if (not AttTgLst) (setq AttTgLst (list ())) ) ;_ end of if (setq i 1) (while (= 'LIST (type (setq CurAttLst (nth i CurBlkLst)))) (setq CurAttTag (car CurAttLst) j 1 stop nil ) ;_ end of setq (while (and (not stop) (setq ATLI (nth j AttTgLst)) ) ;_ end of and (if (= CurAttTag (car ATLI)) (setq stop t) (setq j (1+ j)) ) ;_ end of if ) ;_ end of while (if stop (if (< (cadr ATLI) (strlen (cadr CurAttLst))) (setq AttTgLst (subst (list (car ATLI) (strlen (cadr CurAttLst))) ATLI AttTgLst ) ;_ end of subst ) ;_ end of setq ) ;_ end of if (if (> (strlen (car CurAttLst)) (strlen (cadr CurAttLst))) (setq AttTgLst (append AttTgLst (list (list (car CurAttLst) (strlen (car CurAttLst)) ) ;_ end of list ) ;_ end of list ) ;_ end of append ) ;_ end of setq (setq AttTgLst (append AttTgLst (list (list (car CurAttLst) (strlen (cadr CurAttLst) ) ;_ end of strlen ) ;_ end of list ) ;_ end of list ) ;_ end of append ) ;_ end of setq ) ;_ end of if ) ;_ end of if (setq i (1+ i)) ) ;_ end of while ) ;_ end of progn ) ;_ end of if ) ;_ end of if ) ;_ end of defun (defun lc_BldMstrLst (CurBlkLst / dummylist newlist) (if (/= 'LIST (type CurBlkLst)) (princ "\nERROR(lc_BldMstrLst): argument given must be a list" ) ;_ end of princ (progn (if (not MstrBlkLst) (setq MstrBlkLst (list (append (list 1) CurBlkLst)) MstrIndx (list CurBlkLst) ) ;_ end of setq (if (setq dummylist (member CurBlkLst MstrIndx)) (setq dummylist (nth (- (length MstrIndx) (length dummylist)) MstrBlkLst ) ;_ end of nth newlist (append (list (1+ (car dummylist))) (cdr dummylist) ) ;_ end of append MstrBlkLst (subst newlist dummylist MstrBlkLst) ) ;_ end of setq (setq MstrIndx (append MstrIndx (list CurBlkLst)) MstrBlkLst (append MstrBlkLst (list (append (list 1) CurBlkLst)) ) ;_ end of append ) ;_ end of setq ) ;_ end of if ) ;_ end of if ) ;_ end of progn ) ;_ end of if ) ;_ end of defun (defun lc_BldTmpFl (/ fp HdrLst MaxQty MaxBlkNm i j k CurItem CurLine CurClmn CurAtt stop QtyLbl BlkNmLbl BlkTotal ) (if (not (setq fp (open "temp.ez" "w"))) (princ "\nERROR(lc_BldTmpFl): unable to open temporary file program ending" ) ;_ end of princ (if (not MstrBlkLst) (princ "\nERROR(lc_BldTmpFl): error reading master block list program ending" ) ;_ end of princ (progn (princ _p22$) (setq QtyLbl _p23$ BlkNmLbl _p24$ MaxQty (1- (expt 10 (strlen QtyLbl))) MaxBlkNm (strlen BlkNmLbl) BlkTotal 0 j 0 ) ;_ end of setq (while (setq CurItem (nth j MstrBlkLst)) (if (> (car CurItem) MaxQty) (setq MaxQty (car CurItem)) ) ;_ end of if (if (> (strlen (cadr CurItem)) MaxBlkNm) (setq MaxBlkNm (strlen (cadr CurItem))) ) ;_ end of if (setq BlkTotal (+ BlkTotal (car CurItem)) j (1+ j) ) ;_ end of setq ) ;_ end of while (setq HdrLst (list (list QtyLbl (strlen (itoa MaxQty))) (list BlkNmLbl MaxBlkNm ) ;_ end of list ) ;_ end of list ) ;_ end of setq (if (= 'LIST (type AttTgLst)) (setq HdrLst (append HdrLst (cdr AttTgLst))) ) ;_ end of if (setq j 0) (while (setq CurItem (nth j HdrLst)) (princ (lc_PadFld (car CurItem) (cadr CurItem) " ") fp) (princ " " fp) (setq j (1+ j)) ) ;_ end of while (princ "\n" fp) (setq j 0) (while (setq CurItem (nth j HdrLst)) (princ (lc_PadFld "" (cadr CurItem) "-") fp) (princ "--" fp) (setq j (1+ j)) ) ;_ end of while (princ "\n" fp) (setq j 0) (repeat (length MstrBlkLst) (spin) (setq CurLine (nth j MstrBlkLst)) (princ (lc_PadFld (itoa (nth 0 CurLine)) (cadr (nth 0 HdrLst)) " " ) ;_ end of lc_PadFld fp ) ;_ end of princ (princ " " fp) (princ (lc_PadFld (nth 1 CurLine) (cadr (nth 1 HdrLst)) " ") fp ) ;_ end of princ (princ " " fp) (setq i 2) (repeat (- (length HdrLst) 2) (setq CurClmn (nth i HdrLst)) (setq k 2 stop nil ) ;_ end of setq (while (and (not stop) (setq CurAtt (nth k CurLine)) ) ;_ end of and (if (= (car CurAtt) (car CurClmn)) (setq stop t) (setq k (1+ k)) ) ;_ end of if ) ;_ end of while (if stop (princ (lc_PadFld (cadr CurAtt) (cadr CurClmn) " ") fp) (princ (lc_PadFld "" (cadr CurClmn) ".") fp) ) ;_ end of if (princ " " fp) (setq i (1+ i)) ) ;_ end of repeat (princ "\n" fp) (setq j (1+ j)) ) ;_ end of repeat (princ "\n" fp) (princ (strcat (itoa BlkTotal) _p25$) fp) (close fp) "ok" ) ;_ end of progn ) ;_ end of if ) ;_ end of if ) ;_ end of defun (defun lc_PadFld (Strng StrWdth PadChar /) (if (or (/= 'STR (type Strng)) (/= 'INT (type StrWdth)) (/= 'STR (type PadChar) ) ;_ end of /= ) ;_ end of or (progn (princ "\nERROR(lc_BapFld): function received improper arguments" ) ;_ end of princ "error" ) ;_ end of progn (progn (repeat (- StrWdth (strlen Strng)) (setq Strng (strcat Strng PadChar)) ) ;_ end of repeat Strng ) ;_ end of progn ) ;_ end of if ) ;_ end of defun (defun lc_ShUsr (/ fp CurLine LineNum) (textscr) (terpri) (if (not (setq fp (open "temp.ez" "r"))) (princ "\nERROR(lc_ShUsr): Unable to open temporary file") (if (not (setq CurLine (read-line fp))) (princ "\nERROR(lc_ShUsr): can't read 1st line of temporary file" ) ;_ end of princ (progn (setq LineNum 1) (while (and (not (> LineNum 24)) CurLine ) ;_ end of and (if (< 79 (strlen CurLine)) (setq CurLine (strcat (substr CurLine 1 78) ">")) ) ;_ end of if (princ CurLine) (princ "\n") (setq LineNum (1+ LineNum) CurLine (read-line fp) ) ;_ end of setq ) ;_ end of while (while (= LineNum 25) ; (getstring _p26$) (princ "\n") (setq LineNum 1) (while (and (not (> LineNum 24)) CurLine ) ;_ end of and (if (< 79 (strlen CurLine)) (setq CurLine (strcat (substr CurLine 1 78) ">")) ) ;_ end of if (princ CurLine) (princ "\n") (setq LineNum (1+ LineNum) CurLine (read-line fp) ) ;_ end of setq ) ;_ end of while ) ;_ end of while (close fp) "ok" ) ;_ end of progn ) ;_ end of if ) ;_ end of if ) ;_ end of defun (defun enter (num / x linnam tmp leng i oldsub) (setq _clay (getvar "CLAYER") _ccol (getvar "CECOLOR") _cele (getvar "ELEVATION") _cgri (getvar "GRIDMODE") _cort (getvar "ORTHOMODE") _cblp (getvar "BLIPMODE") _cthk (getvar "THICKNESS") _csnp (getvar "SNAPANG") _csnu (getvar "SNAPUNIT") _cspm (getvar "SNAPMODE") _cosp (getvar "OSMODE") _cmde (getvar "CMDECHO") _tunt (getvar "LUNITS") _uang (getvar "AUNITS") _adr (getvar "ANGDIR") _atd (getvar "ATTDIA") _atr (getvar "ATTREQ") _cabs (getvar "ANGBASE") _tsze (getvar "TEXTSIZE") _pbox (getvar "PICKBOX") _ucso (getvar "UCSORG") _ucsx (getvar "UCSXDIR") _ucsy (getvar "UCSYDIR") _tsty (getvar "TEXTSTYLE") ) ;_ end of setq (setvar "CMDECHO" 0) (command "_.UNDO" "_M") (setvar "BLIPMODE" 0) (setvar "GRIDMODE" 0) (setvar "HIGHLIGHT" 1) (setvar "ANGDIR" 0) (setvar "ANGBASE" 0) (setvar "ATTDIA" 0) (setvar "ATTREQ" 1) (setq _stht (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) ) ;_ end of setq (if (/= _stht 0.0) (progn (setvar "textsize" _stht) (setq ccs (getvar "cmdactive")) (command "_.style" "" "" "0") (while (> (getvar "cmdactive") ccs) (command "") ) ;_ end of while ) ;_ end of progn ) ;_ end of if (if (= _scale nil) (setq _scale 1.0) ) ;_ end of if (if (or (= (getvar "LUNITS") 3) (= (getvar "LUNITS") 4)) (setq _scfac _scale) (setq _scfac (/ _scale 12.0)) ) ;_ end of if (princ) ) ;_ end of defun (defun leave (/ echv ccs) (setvar "CMDECHO" 0) (setvar "HIGHLIGHT" 1) (if (tblsearch "layer" _clay) (command "_.layer" "_s" _clay "") ) ;_ end of if (setvar "textstyle" _tsty) (if (/= _stht 0.0) (progn (setq ccs (getvar "cmdactive")) (command "_.style" "" "" _stht) (while (> (getvar "cmdactive") ccs) (command "") ) ;_ end of while ) ;_ end of progn ) ;_ end of if (if (or (not (equal _ucso (getvar "UCSORG"))) (not (equal _ucsx (getvar "UCSXDIR") ) ;_ end of equal ) ;_ end of not (not (equal _ucsy (getvar "UCSYDIR"))) ) ;_ end of or (command "_.ucs" "_p") ) ;_ end of if (setvar "CECOLOR" _ccol) (setvar "GRIDMODE" _cgri) (setvar "ORTHOMODE" _cort) (setvar "BLIPMODE" _cblp) (setvar "THICKNESS" _cthk) (setvar "SNAPANG" _csnp) (setvar "SNAPMODE" _cspm) (setvar "SNAPUNIT" _csnu) (setvar "OSMODE" _cosp) (setvar "ANGDIR" _adr) (setvar "ANGBASE" _cabs) (setvar "AUNITS" _uang) (setvar "LUNITS" _tunt) (setvar "CMDECHO" _cmde) (setvar "ATTDIA" _atd) (setvar "ATTREQ" _atr) (setvar "textsize" _tsze) (setvar "PICKBOX" _pbox) (setvar "menuecho" 0) (princ) ) ;_ end of defun (DEFUN TBSTRP (Qj / Q@ QQ Ql) (IF Qj (PROGN (IF (NOT _TABSZ) (SETQ _TABSZ 8) ) ;_ end of IF (SETQ QQ 1 Q@ NIL ) ;_ end of SETQ (REPEAT (STRLEN Qj) (SETQ Q@ (APPEND Q@ (LIST (SUBSTR Qj QQ 1))) QQ (1+ QQ) ) ;_ end of SETQ ) ;_ end of REPEAT (IF (MEMBER "\t" Q@) (PROGN (SETQ QQ 0 Qj "" Ql (NTH QQ Q@) ) ;_ end of SETQ (WHILE Ql (IF (= Ql "\t") (REPEAT (- _TABSZ (REM (STRLEN Qj) _TABSZ)) (SETQ Qj (STRCAT Qj " ")) ) ;_ end of REPEAT (SETQ Qj (STRCAT Qj Ql)) ) ;_ end of IF (SETQ QQ (1+ QQ) Ql (NTH QQ Q@) ) ;_ end of SETQ ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (EVAL Qj) ) ;_ end of DEFUN (enter (+ 1)) (setvar "osmode" 512) (setq ans (entsel _p27$)) (while ans (setq llist (cons (cdr (assoc '8 (entget (car ans)))) llist) ans (entsel _p28$) ) ;_ end of setq ) ;_ end of while (setvar "osmode" _cosp) (if (not llist) (setq ss (ssget "X" (list (cons 0 "INSERT") (cons -4 "") ) ;_ end of list ) ;_ end of ssget ) ;_ end of setq (progn (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 8 (nth 0 llist)))) CurLay 1 ) ;_ end of setq (repeat (1- (length llist)) (setq ss1 (ssget "X" (list (cons 0 "INSERT") (cons 8 (nth CurLay llist))) ) ;_ end of ssget CurLay (1+ CurLay) CurEnt 0 ) ;_ end of setq (if ss1 (progn (if (not ss) (setq ss (ssadd (ssname ss1 CurEnt)) CurEnt (1+ CurEnt) ) ;_ end of setq ) ;_ end of if (repeat (- (sslength ss1) CurEnt) (ssadd (ssname ss1 CurEnt) ss) (setq CurEnt (1+ CurEnt)) ) ;_ end of repeat ) ;_ end of progn ) ;_ end of if ) ;_ end of repeat ) ;_ end of progn ) ;_ end of if (princ _p29$) (if (not ss) (princ "\nERROR(C:CountBlocks): no blocks found program ending" ) ;_ end of princ (progn (princ _p30$) (if (/= 'LIST (type spin)) (spin) ) ;_ end of if (setq i 0) (repeat (sslength ss) (setq CurBlk (ssname ss i) CurBlkLst (list (cdr (assoc '2 (setq CurBlkEG (entget CurBlk)))) ) ;_ end of list ) ;_ end of setq (if (assoc '66 CurBlkEG) (progn (setq CurAtt (entnext CurBlk)) (while (/= "SEQEND" (cdr (assoc '0 (setq CurAttEG (entget CurAtt)))) ) ;_ end of /= (setq CurBlkLst (append CurBlkLst (list (list (cdr (assoc '2 CurAttEG ) ;_ end of assoc ) ;_ end of cdr (cdr (assoc '1 CurAttEG ) ;_ end of assoc ) ;_ end of cdr ) ;_ end of list ) ;_ end of list ) ;_ end of append CurAtt (entnext CurAtt) ) ;_ end of setq ) ;_ end of while (lc_BldAttLst CurBlkLst) ) ;_ end of progn ) ;_ end of if (lc_BldMstrLst CurBlkLst) (if (= (rem i 5) 0) (spin) ) ;_ end of if (setq i (1+ i)) ) ;_ end of repeat (if (= "ok" (lc_BldTmpFl)) (if (= "ok" (lc_ShUsr)) (lc_QryUsr) ) ;_ end of if ) ;_ end of if ) ;_ end of progn ) ;_ end of if (leave) ) ;_ end of defun ;;; ;þmodname: def-catt.lspþ þversion: 1.0þ þdate: 1992 Nov 25þ ;;; ;þlgbþ ;;; ; 1.0 1992 Nov 25 kenm ;;; ;translated to german language by U. Hock, March 1993 ;;; ;þlgeþ (defun def-catt (/) (setq _p0$ "CHGATT" ;NICHTS ÄNDERN!!! _p1$ "\nIch lade, bitte warten..." _p2$ "\nWählen Sie einen Kontroll Block" _p3$ "\nWählen Sie die zu ändernden Blöcke oder RETURN für alle: " _p4$ "\nIch arbeite " _p5$ " Blöcke aktualisiert." _p6$ "\nFehler in C:CHGATT, gewähltes Element ist kein Block! " ) ;_ end of setq (princ) ) ;ende defun ;;; ;þmodname: def-cb.lspþ þdate: 1993 Feb 11þ þversion: 1.2þ ;;; ;þlgbþ ;;; ; 1.0 1992 Jul 20 david first version under source control ;;; ; 1.1 1992 Aug 4 david added version control log ;;; ; 1.2 1993 Feb 11 david updated prompts ;;; ; translated to german language by U. Hock, March 1993 ;;; ;þlgeþ (defun def-cb (/) (setq _p0$ "COUNTBLOCKS" ; NICHTS ÄNDERN!!! _p1$ "\nIch lade, bitte warten..." _p2$ "Schreiben Anhängen Zeichnung Exit X" ;keywords _p3$ "\n[S]chreiben, [A]nhängen, in [Z]eichnung einfügen oder e[X]it? : " _p4$ "X" ;keyword from above _p5$ "Exit" ;keyword from above _p6$ "Anhängen" ;keyword from above _p7$ "\nBitte geben Sie den Dateinamen ein an den angehängt werden soll: " _p8$ "\nBitte wiederholen Sie Ihre Wahl" _p9$ "\nKann Datei nicht finden " _p10$ " Bitte wiederholen Sie Ihre Wahl" _p11$ "shell" ;ACAD.PGP shell command _p12$ "\nDie Datei " _p13$ " wurde angehängt an" _p14$ "Schreiben" ;keyword from above _p15$ "\nBitte geben Sie den Namen der zu erzeugenden Datei ein: " _p16$ "J N" ;keywords _p17$ "\nWARNUNG: Die Datei " _p18$ " existiert bereits.\n Wollen Sie sie überschreiben (J/N) : " _p19$ "J" ;keyword from above _p20$ " wurde erstellt" _p21$ "Zeichnung" ;keyword from above _p22$ "\nErstelle Temp Datei " _p23$ "ANZ" ;header quantity label _p24$ "BLK_NAME" ;header block name label _p25$ " Blöcke\n" _p26$ "--MEHR-- (Return für mehr)" _p27$ "\nWählen Sie ein Objekt auf einem Layer oder RETURN für alle Layer: " _p28$ "\nWählen Sie ein Objekt auf einem anderen Layer oder RETURN zum beenden: " _p29$ "\nBlock Auswahl beendet" _p30$ "\nIch arbeite, bitte warten " ) ; end setq (princ) ) ;defun ;;; ;þmodname: def-drwt.lspþ þversion: 1.2þ þdate: 1993 Jan 4þ ;;; ;þlgbþ ;;; ; 1.0 1992 Jul 20 david first version under source control for landcadd ;;; ; 1.1 1992 Nov 25 kenm ;;; ; 1.2 1993 Jan 4 david updated file to work with new drawtext ;;; ; translated to german language by M. Frey, May 1993 ;;; ;þlgeþ (defun def-drwt (/) (setq _p0$ "DRAWTEXT" ; NICHTS ÄNDERN!!! _p1$ "\nIch lade, bitte warten..." _p2$ "\nAusrichtungs Optionen:" _p3$ "OLinks" _p4$ "OZentriert" _p5$ "ORechts" _p6$ "MLinks" _p7$ "MZentriert" _p8$ "MRechts" _p9$ "ULinks" _p10$ "UZentriert" _p11$ "URechts" _p12$ "Links" _p13$ "Zentrieren" _p14$ "Rechts" _p15$ "Ausrichten" _p16$ "Mitte" _p17$ "Einpassen" _p18$ "\n\nMit beliebiger Taste zurück zur Zeichnung. " _p19$ "\r " ;this line should be as long as the one above _p20$ "ERROR: Kann Temporärdatei nicht öffnen\n" _p21$ " Funktion abgebrochen" _p22$ "Einzulesende Datei" _p23$ "\nEinzulesende Datei (einschließlich Erweiterung)/<" _p24$ "\n\tDatei gefunden, kann sie aber " _p25$ " nicht öffnen. " _p26$ "\nDatei nicht gefunden. Erweiterung fehlt möglicherweise." _p27$ "\nDatei nicht gefunden. " _p28$ "\nStartpunkt oder Zentrieren/Mitte/Rechts/?: " _p29$ " Punkt: " _p30$ "\nNächster Punkt: " _p31$ "\nTextstil <" _p32$ " Dieser Textstil ist nicht verfügbar, erneute Eingabe bitte\n" _p33$ "\nTextstil <" _p34$ "\nDer aktuelle Textstil wird beibehalten" _p35$ "\nHöhe <" _p36$ "\nEinfüge-Winkel <" _p37$ "WARNUNG: Nur die erste Zeile der Textdatei\n" _p38$ " wird eingepaßt." ) ;_ end of setq (princ) ) ;ende defun (defun drawtext (/ rf rfa rtfile j cont pt pt2 pt1 tsg tsn ccs ts h ang s flag) (defun 1LTXT (/ old_aunits ji) (cond ((= _p3$ j) (setq ji "_TL")) ((= _p4$ j) (setq ji "_TC")) ((= _p5$ j) (setq ji "_TR")) ((= _p6$ j) (setq ji "_ML")) ((= _p7$ j) (setq ji "_MC")) ((= _p8$ j) (setq ji "_MR")) ((= _p9$ j) (setq ji "_BL")) ((= _p10$ j) (setq ji "_BC")) ((= _p11$ j) (setq ji "_BR")) ((= _p12$ j) (setq ji "_L")) ((= _p13$ j) (setq ji "_C")) ((= _p14$ j) (setq ji "_R")) ((= _p15$ j) (setq ji "_A")) ((= _p16$ j) (setq ji "_M")) ((= _p17$ j) (setq ji "_F")) ) ;_ end of cond (setq old_aunits (getvar "aunits")) (setvar "aunits" 3) ;(setq s (tbstrp s)) (cond ((or (= ji "_A") (and (= ji "_F") (null h) ) ;_ end of and ) ;_ end of or (command "_.TEXT" ji pt pt2 s) ) ((and (= ji "_F") h ) ;_ end of and (command "_.TEXT" ji pt pt2 h s) ) ((and (= ji "_L") h ) ;_ end of and (command "_.TEXT" pt h ang s) ) ((and (= ji "_L") (null h) ) ;_ end of and (command "_.TEXT" pt ang s) ) ((and (/= ji "_L") h ) ;_ end of and (command "_.TEXT" ji pt h ang s) ) ((and (/= ji "_L") (null h) ) ;_ end of and (command "_.TEXT" ji pt ang s) ) ) ;_ end of cond (setvar "aunits" old_aunits) ) ;_ end of defun (defun justpn () (if (getvar "DIMCLRD") (textpage) ) ;_ end of if (princ _p2$) (princ (strcat "\n\t" _p3$ "\t" _p4$ "\t" _p5$)) (princ (strcat "\n\t" _p6$ "\t" _p7$ "\t" _p8$)) (princ (strcat "\n\t" _p9$ "\t" _p10$ "\t" _p11$)) (princ (strcat "\n\t" _p12$ "\t" _p13$ "\t" _p14$)) (princ (strcat "\n\t" _p15$ "\t" _p16$ "\t" _p17$)) (if (not (getvar "DIMCLRD")) (textscr) ) ;_ end of if (princ _p18$) (grread) (princ _p19$) (graphscr) ) ;_ end of defun (if (/= _p0$ "DRAWTEXT") (def-drwt) ) ;_ end of if (if _AutoIns (progn (setq _AutoIns nil rtfile (open "temp.ez" "r") ) ;_ end of setq (if (not rtfile) (progn (alert (strcat _p20$ _p21$)) (exit) ) ;_ end of progn ) ;_ end of if ) ;_ end of progn (progn (while (null rtfile) (if (and (= (type _TNAME) 'STR) (> (strlen _TNAME) 0) ) ;_ end of and (if (= 1 (getvar "FILEDIA")) (setq rf (getfiled _p22$ _TNAME "" 12)) (progn (princ _p23$) (princ (strcat _TNAME ">: ")) (setq rf (getstring)) ) ;_ end of progn ) ;_ end of if (if (= 1 (getvar "FILEDIA")) (setq rf (getfiled _p22$ "" "" 12)) (progn (initget 1) (princ _p23$) (setq rf (getstring)) ) ;_ end of progn ) ;_ end of if ) ;_ end of if (if (= rf nil) (exit) ) ;_ end of if (if (= rf 1) (if (null _TNAME) (progn (initget 1) (princ _p23$) (setq rf (getstring)) ) ;_ end of progn (progn (princ _p23$) (princ (strcat _TNAME ">: ")) (setq rf (getstring)) ) ;_ end of progn ) ;_ end of if ) ;_ end of if (if (and (= rf "") (and (= (type _TNAME) 'STR) (> (strlen _TNAME) 0) ) ;_ end of and ) ;_ end of and (setq rf _TNAME) ) ;_ end of if (setq rfa (findfile rf)) (if (= "~" rf) (progn (setq rfa nil) (setq rtfile nil) ) ;_ end of progn ) ;_ end of if (if rfa (progn (setq _TNAME rfa) (if (null (setq rtfile (open rfa "r"))) (princ (strcat _p24$ _TNAME _p25$)) ) ;_ end of if ) ;_ end of progn (if (/= "~" rf) (if (and (< 4 (strlen rf)) (/= (substr rf (- (strlen rf) 3) 1) ".") ) ;_ end of and (princ _p26$) (princ _p27$) ) ;_ end of if ) ;_ end of if ) ;_ end of if ) ;_ end of while ) ;_ end of progn ) ;_ end of if (setq cont T) (while cont (if (getvar "DIMCLRD") (initget 1 (strcat _p3$ " " _p4$ " " _p5$ " " _p6$ " " _p7$ " " _p8$ " " _p9$ " " _p10$ " " _p11$ " " _p15$ " " _p13$ " " _p17$ " " _p12$ " " _p16$ " " _p14$ " " "?" ) ;_ end of strcat ) ;_ end of initget (initget (strcat 1 _p15$ " " _p13$ " " _p17$ " " _p12$ " " _p16$ " " _p14$ " " "?" ) ;_ end of strcat ) ;_ end of initget ) ;_ end of if (setq pt (getpoint _p28$)) (if (/= (type pt) 'LIST) (if (= pt "?") (progn (justpn) (setq cont T) ) ;_ end of progn (progn (setq cont nil j pt ) ;_ end of setq (if (= j _p13$) (setq j _p7$) ) ;_ end of if (initget 1) (setq pt (getpoint (strcat "\n" pt _p29$))) (if (or (= j _p15$) (= j _p17$)) (progn (initget 1) (setq pt2 (getpoint pt (strcat _p30$)) at_ang (angle pt pt2) ) ;_ end of setq ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ) ;_ end of if (setq j _p12$ cont nil ) ;_ end of setq ) ;_ end of if ) ;_ end of while (setq pt1 pt) (setq tsn (getstring (strcat _p31$ (getvar "textstyle") ">: "))) (if (= tsn "") (setq tsn (getvar "textstyle")) (progn (while (not (tblsearch "style" tsn)) (princ _p32$) (setq tsg (getstring (strcat _p33$ tsn ">: "))) (if (/= tsg "") (setq tsn tsg) (progn (princ _p34$) (setq tsn (getvar "textstyle")) ) ;_ end of progn ) ;_ end of if ) ;_ end of while ) ;_ end of progn ) ;_ end of if (if (/= (strcase tsn) (getvar "textstyle")) (progn (setq ccs (getvar "cmdactive")) (command "_.style" tsn) (while (> (getvar "cmdactive") ccs) (command "") ) ;_ end of while ) ;_ end of progn ) ;_ end of if (setq ts (tblsearch "STYLE" (getvar "TEXTSTYLE")) h nil ) ;_ end of setq (if (and (/= j _p15$) (= (cdr (assoc 40 ts)) 0.0) ) ;_ end of and (progn (initget 6) (setq h (getdist pt (strcat _p35$ (rtos (getvar "TEXTSIZE")) ">: ")) ) ;_ end of setq (if (null h) (setq h (getvar "TEXTSIZE")) ) ;_ end of if ) ;_ end of progn ) ;_ end of if (if (not (numberp at_ang)) (if (= (cdr (assoc 70 ts)) 4) (setq at_ang (* 1.5 pi)) (setq at_ang 0) ) ;_ end of if ) ;_ end of if (if (and (/= j _p15$) (/= j _p17$) ) ;_ end of and (progn (princ (strcat _p36$ (angtos at_ang) ">: ")) (setq ang (getangle pt)) ) ;_ end of progn ) ;_ end of if (if (null ang) (setq ang at_ang) (setq at_ang ang) ) ;_ end of if (setvar "BLIPMODE" 0) (setvar "HIGHLIGHT" 0) (setvar "CMDECHO" 0) (if (setq s (read-line rtfile)) (progn (1ltxt) (if (= j _p15$) (setq flag t) (setq flag nil) ) ;_ end of if (while (setq s (read-line rtfile)) (if flag (progn (setq flag nil) (alert (strcat _p37$ _p38$)) ) ;_ end of progn ) ;_ end of if ;(setq s (tbstrp s)) (command "_.TEXT" "" s) ) ;_ end of while ) ;_ end of progn ) ;_ end of if (close rtfile) (princ) ) ;_ end of defun (defun spin () (setq spina (if spina spina 4 ) ;_ end of if ) ;_ end of setq (princ (cond ((= (rem (setq spina (1+ spina)) 4 ) ;_ end of rem 0 ) ;_ end of = "\010|" ) ((= (rem spina 4) 1) "\010/") ((= (rem spina 4) 2) "\010-") ((= (rem spina 4) 3) "\010\\") ) ;_ end of cond ) ;_ end of princ ) ;_ end of defun (defun C:CB () (C:countblocks) ) ;_ end of defun (prompt "\nProgrammaufruf durch CountBlocks oder CB") (terpri) (graphscr) (PRINC) ;|«Visual LISP© Format Options» (72 2 40 1 T "end of " 60 9 0 0 0 nil T nil T) ;*** KEINEN Text unterhalb des Kommentars hinzufügen! ***|;