home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p058 / 1.img / SYS.PAK / BL.LSP < prev    next >
Encoding:
Text File  |  1990-04-02  |  8.8 KB  |  2 lines

  1. (SETQ Sj *ERROR* S@(STRCAT BLDRIVE"\\BL\\System\\")SQ"Minsert"Sl"Insert"S&"Redefine"S1"WBLOCK"S#"ATTDEF"S0"OSMODE"S$"AFLAGS"SO"BL.CFG"S| NIL S% NIL)(IF(="AutoLISP Release 9.0"(VER))(DEFUN TRANS(S?j Sjj S@j)S?j))(DEFUN SQj(Slj / S&j)(IF(SETQ S&j(OPEN Slj"r"))(NOT(SETQ S&j(CLOSE S&j)))))(DEFUN S1j(S#j)(IF(SQj(STRCAT S#j".sld"))(PROGN(COMMAND"vslide"(STRCAT"*"S#j)"vslide"NIL)T)(PROMPT(STRCAT"\n\nCannot open slide file <"S#j">."))))(S1j(STRCAT S@"BL"))(PROMPT"BL.LSP  Release 10.5  BLOCK Librarian")(TERPRI)(PROMPT"Copyright (c) 1987-1990 SoftSource Inc. All rights reserved.")(TERPRI)(DEFUN S0j(S$j)(IF S$j(PROGN(SETQ SOj 1 S|j S$j)(IF(S1j(STRCAT S%j"\\BLQUAD"(CADR(ASSOC S$j(quote ((0"A")(5"B")(50"C")(55"D")))))))T(S?@)))))(DEFUN Sj@(S@@ S$j / SQ@)(SETQ SQ@ S@@)(WHILE(AND SQ@(NOT(AND(> S$j(CAAR SQ@))(< S$j(CADAR SQ@)))))(SETQ SQ@(CDR SQ@)))(IF SQ@(CADDAR SQ@)NIL))(DEFUN Sl@(S&@ S1@)(IF(AND(> S&@ 3)(< S&@ 52))(S0j(Sj@(quote ((211 245 0)(172 206 50)))S1@)))(IF(AND(> S&@ 57)(< S&@ 108))(S0j(Sj@(quote ((211 245 5)(172 206 55)))S1@)))(SETQ S#@ NIL))(DEFUN S0@(S&@ S1@ / S$@ SO@)(SETQ S$@(Sj@(quote ((446 521 5)(371 446 4)(297 371 3)(222 297 2)(148 222 1)))S&@)SO@(Sj@(quote ((0 51 40)(51 103 30)(103 156 20)(156 208 10)(208 260 0)))S1@)S#@ NIL)(IF(AND SO@ S$@)(SETQ S#@(-(+ S$@ SO@ S|j)1))))(DEFUN S|@(S&@ S1@ S|j / S$@ SO@)(SETQ S$@(Sj@(quote ((149 186 5)(112 149 4)(75 112 3)(37 75 2)(0 37 1)))S&@)SO@(Sj@(quote ((0 26 40)(26 52 30)(52 78 20)(78 104 10)(104 130 0)))S1@)S#@ NIL)(IF(AND SO@ S$@)(SETQ S#@(-(+ S$@ SO@ S|j)1))))(DEFUN S%@(S&@ S1@)(IF(< S&@ 316)(IF(< S1@ 130)(SETQ S|j 50 S&@(- S&@ 130))(IF(> S1@ 143)(SETQ S|j 0 S&@(- S&@ 130)S1@(- S1@ 143)))))(IF(> S&@ 335)(IF(< S1@ 130)(SETQ S|j 55 S&@(- S&@ 335))(IF(> S1@ 143)(SETQ S|j 5 S&@(- S&@ 335)S1@(- S1@ 143)))))(S|@ S&@ S1@ S|j))(DEFUN S?Q(/ S&@ S1@)(SETQ S&@(TRANS(GETVAR"vsmax")1 2)S1@(TRANS(GETVAR"vsmin")1 2)SjQ(GETVAR"viewsize")S@Q(* SjQ(/(-(CAR S&@)(CAR S1@))(-(CADR S&@)(CADR S1@))))S&@(TRANS(GETVAR"viewctr")1 2)S1@(GETVAR"screensize")SQQ(LIST(-(CAR S&@)(/ S@Q 2.0))(-(CADR S&@)(/ SjQ 2.0)))SlQ(CAR S1@)S&Q(CADR S1@)))(DEFUN S1Q()(IF(= SOj 1)(S0j S|j)(S?@)))(DEFUN S?@()(SETQ SOj 0)(IF(S1j(STRCAT S%j"\\MASTER"))T(SETQ S%j NIL)))(DEFUN S#Q()(IF(S1j(STRCAT S@"MASTPOIN"))(PROGN(INITGET 9)(SETQ S0Q(GETVAR S0))(SETVAR S0 0)(SETQ S$Q(TRANS(GETPOINT"\nSelect master point")1 2)S$Q(LIST(/(/(-(CAR S$Q)(CAR SQQ))(/ S@Q SlQ))522)(/(/(-(CADR S$Q)(CADR SQQ))(/ SjQ S&Q))274)))(SETVAR S0 S0Q)(SOQ))))(DEFUN S|Q(S%Q / S?l S&@ S1@ Sjl)(SETQ Sjl(GETVAR S0))(SETVAR S0 0)(INITGET 9)(SETQ S?l(TRANS(GETPOINT(STRCAT"\n\nSelect "S%Q))1 2))(SETVAR S0 Sjl)(SETQ S&@(FIX(/(/(-(CAR S?l)(CAR SQQ))(/ S@Q SlQ))(CAR S$Q)))S1@(FIX(/(/(-(CADR S?l)(CADR SQQ))(/ SjQ S&Q))(CADR S$Q)))S#@ NIL)(LIST S&@ S1@))(DEFUN S@l(S$j / S&@ S1@)(SETQ S&@(CAR S$j)S1@(CADR S$j))(IF(AND(= SOj 0)(> S&@ 130)(< S&@ 522)(< S1@ 274))(S%@ S&@ S1@)(IF(AND(= SOj 1)(> S&@ 148)(< S&@ 521)(< S1@ 260))(S0@ S&@ S1@)(SETQ S#@ NIL))))(DEFUN SQl(S$j / S&@ S1@)(SETQ S&@(CAR S$j)S1@(CADR S$j))(IF(AND(> S&@ 0)(< S&@ 111))(PROGN(IF(AND(> S1@ 0)(< S1@ 39))(SETQ S&@ 0 Sll T S&l T))(IF S1l(IF(AND(> S1@ 234)(< S1@ 274))(S#l""))(IF(AND(> S1@ 248)(< S1@ 274))(S?@)))(IF(AND(> S&@ 3)(< S&@ 108)(NOT S1l))(IF S0l(EVAL(Sj@(quote ((172 245(Sl@ S&@ S1@))(133 159(S$l))))S1@))(EVAL(Sj@(quote ((172 245(Sl@ S&@ S1@))(133 159(S$l))(103 129(SOl"S"T))(73 99(SOl"E"T))(43 69(PROGN(REDRAW)(S|l)(IF(NOT Sll)(S1Q))))))S1@)))))))(DEFUN S%l(S$j / S&j)(IF(= S$j 0)(S?&)(PROGN(SETQ Sj& S$j S@&(/ S$j 10)S%j(STRCAT SQ&"\\"(ITOA Sj&)))(IF(S?@)(PROGN(SOQ)(SETQ S#@ NIL S$j T))))))(DEFUN S$l(/ S$j)(SETQ S%j NIL SOj 0)(WHILE(AND(NOT S%j)(NOT Sll))(S1j(STRCAT SQ&"\\BOOK"))(SETQ S1l T S#@ NIL Sll NIL)(WHILE(AND(= S#@ NIL)(NOT Sll))(SETQ S$j(S|Q"Page : "))(SQl S$j)(S@l S$j))(IF(NOT Sll)(IF(AND(NOT(S%l S#@))(/= S#@ 0))(IF(Sl& S#@)(SETQ S1l NIL))(SETQ S1l NIL)))))(DEFUN Sl&(S$j)(TERPRI)(PRINC(STRCAT"PAGE #"(ITOA S$j)" is not available. "))(IF(S&&"Make PAGE available for use")(PROGN(S1&(STRCAT S@"newpage "SQ&"\\"(ITOA S$j)))(S1&(STRCAT S@(S#&)" -p"(ITOA S$j)))(S%l S$j))))(DEFUN S0&(S#j)(IF(/= S$& S#j)(S#l S#j))(SQj(STRCAT SQ&"\\BOOK.SLD")))(DEFUN SO&(S#j)(SQj(STRCAT S#j".DWG")))(DEFUN S|&()(IF S% T(PROMPT"\nThis library cannot be edited")))(DEFUN S%&(S#@ S?1 Sj1)(IF(NOT Sj1)(IF S?1(ITOA S#@)(STRCAT SQ&"\\"(ITOA(/ S#@ 100))"\\"(ITOA S#@)))(PROGN(IF(< S#@ 10)(SETQ S#j(STRCAT"0"(ITOA S#@)))(SETQ S#j(ITOA S#@)))(IF(AND(> S@& 0)(= Sj& 0))(SETQ S#j(STRCAT"0"S#j))(SETQ S#j(ITOA(+ S#@(* Sj& 100)))))(IF S?1 S#j(STRCAT S%j"\\"S#j)))))(DEFUN S@1(S#@ Sj1 / S$j)(TERPRI)(SETQ SQ1(S%& S#@ NIL Sj1)Sl1(STRCAT S$&"_"(S%& S#@ T Sj1)))(IF(NOT(TBLSEARCH"BLOCK"Sl1))(IF(SO& SQ1)(S&1(STRCAT Sl1"="SQ1)(S11 NIL))(PROGN(PROMPT(STRCAT"\nCannot open block file <"SQ1">"))(SETQ S#@ 0)))(PROGN(SETQ S$j(S11 T))(IF(= S$j S&)(S&1(STRCAT Sl1"="SQ1)S$j)(S&1 Sl1 S$j)))))(DEFUN S11(Sj1 / S$j)(SETQ S$j(STRCAT Sl" "SQ(IF Sj1(STRCAT" "S&)"")))(INITGET S$j)(IF S|(GETKWORD(STRCAT S$j" <"Sl"> : "))Sl))(DEFUN S&1(S#j S$j)(SETQ S#1 T)(REDRAW)(COMMAND(IF(= S$j SQ)SQ Sl)S#j))(DEFUN S?&()(TERPRI)(IF(S1j(STRCAT S@"HELP"))(PROGN(GETSTRING"\nPress <ENTER> to return to Block Librarian\n")(IF S%j(S1Q)))))(DEFUN SOQ()(IF(SETQ S&j(OPEN(STRCAT S@ SO)"w"))(PROGN(PRIN1(LIST S$& SQ& Sj& S$Q(IF S% 1 0))S&j)(SETQ S&j(CLOSE S&j)))))(DEFUN S01(/ S$j)(IF(SETQ S$j(S$1 SO T))(SETQ S$Q(SO1 S$j))))(DEFUN BL(S#j S|1)(IF(S0&(STRCASE S#j))(PROGN(SETQ Sj& S|1)(C:BL))(PROGN(PRINC"\nInvalid Library name.\n")(PRINC))))(DEFUN SO1(S$j)(SETQ S$&(CAR S$j)SQ&(CADR S$j)Sj&(CADDR S$j)S%(=(CADR(CDDDR S$j))1)S%j NIL)(CADDDR S$j))(DEFUN S$1(Slj S%1 / S$j S&j)(IF(AND(SETQ S&j(OPEN(STRCAT S@ Slj)"r"))(SETQ S$j(READ-LINE S&j)))(SETQ S&j(CLOSE S&j)S$j(IF S%1(READ S$j)S$j))))(DEFUN S?#(/ S?j)(SETQ S?j(RTOS(FIX(GETVAR"cdate"))))(STRCAT(SUBSTR S?j 5 2)"-"(SUBSTR S?j 7 2)"-"(SUBSTR S?j 3 2)"  "))(DEFUN Sj#(/ S&j S$j)(S?Q)(IF(= S$Q NIL)(S01))(WHILE(= S$Q NIL)(S#Q))(IF S%j(S1Q))(SETQ S&l NIL)(WHILE(NOT S&l)(SETQ S#@ NIL)(IF S%j(WHILE(AND(= S#@ NIL)(NOT S&l))(SETQ S$j(S|Q"cell for new BLOCK location : "))(SQl S$j)(S@l S$j))(S$l))(IF(AND(< S#@ 100)(>= S#@ 0))(IF(SETQ S#j(S@# S#@))(SETQ S&l T)(SETQ S&l NIL SQ# NIL))(SETQ S#j NIL)))S#j)(DEFUN S#&()(STRCAT"UPDATE -d"BLDRIVE" -l"SQ&))(DEFUN Sl#(S#@ S&# / S&j S#j)(SETQ S#j(S%& S#@ T T))(S1&(STRCAT S@(S#&)" -c"S#j))(IF(SETQ S&j(OPEN(STRCAT SQ&"\\ATTRTRAN.LST")"a"))(PROGN(PRINC(STRCAT"("S&#"(BLOCK "S#j")(DATE \""(S?#)"\"))")S&j)(SETQ S&j(CLOSE S&j)))))(DEFUN S&&(S$j)(TERPRI)(INITGET 1"Yes No")(=(GETKWORD(STRCAT S$j"? (y/n) : "))"Yes"))(DEFUN S@#(S1#)(SETQ S#j(S%& S1# NIL T))(IF(S|&)(IF(SO& S#j)(PROGN(SETQ SQ# T)(TERPRI)(PRINC"\nCell chosen appears to contain a BLOCK. ")(IF(S&&"Replace this BLOCK")S#j NIL))S#j)))(DEFUN S##(S0# S$j S$#)(IF(NOT S0#)(PROGN(S1&(STRCAT"DEL "S$j".DWG"))"D")(PROGN(REDRAW)(IF SQ#(PROGN(COMMAND S1 S$j"y"""S$# S0#"""oops"NIL)"U")(PROGN(COMMAND S1 S$j""S$# S0#"""oops"NIL)"A")))))(DEFUN S|l(/ SO# S&# S$# S0# S$j)(SETQ *ERROR* S|# SQ# NIL S0l T)(INITGET 9)(SETQ S$#(GETPOINT"\n\nSelect base point for insertion : "))(PRINC"\n\nSelect BLOCK entities ")(SETQ S0#(SSGET))(IF(Sj#)(Sl# S#@(S## S0#(S%& S#@ NIL T)S$#))(REDRAW))(SETQ S0l NIL S&l T))(DEFUN C:BLSAVE()(SETVAR"CMDECHO"0)(SETQ Sj *ERROR* Sll NIL S1l NIL)(S|l)(SETQ *ERROR* Sj)(PRINC))(DEFUN C:IMPORT()(SETVAR"CMDECHO"0)(SETQ Sj *ERROR* Sll NIL S0l T S1l NIL)(WHILE(NOT Sll)(TERPRI)(SETQ S%#(GETSTRING"Enter filename <enter to exit>: "))(IF(ZEROP(STRLEN S%#))(SETQ Sll T)(IF(SO& S%#)(IF(Sj#)(PROGN(S1&(STRCAT"COPY "S%#".dwg "(S%& S#@ NIL T)".dwg"))(Sl# S#@(IF SQ#"U""A"))))(PRINC"\nThe file does not exist."))))(SETQ S0l NIL S&l T *ERROR* Sj)(PRINC))(DEFUN SOl(Sj1 S?0 / S#@)(IF(NOT S1l)(PROGN(IF(= Sj1"E")(IF(S|&)(Sj0 Sj1))(PROGN(Sj0 Sj1)(IF(SETQ S#@(S$1"AttrPick"T))(IF(AND S#@(=(TYPE S#@)(quote INT)))(S@1 S#@ NIL)))))(IF(AND(NOT S#1)S?0)(IF(NOT(S1Q))(S$l))))))(DEFUN Sj0(Sj1)(S1&(STRCAT S@"ACADLib "Sj1" "BLDRIVE" "SQ&" "(ITOA(* Sj& 100)))))(DEFUN C:BLA()(SOl"S"NIL)(GRAPHSCR))(DEFUN S#l(S#j / S$j)(S1&(STRCAT S@"NEWlib "S#j))(IF(SETQ S$j(S$1"library.nam"T))(PROGN(SETQ S%j NIL Sj& NIL S$&(CAR S$j)SQ&(CADR S$j)S%(=(CADDR S$j)1))(SOQ)(IF S1l(S1j(STRCAT SQ&"\\BOOK"))))(PRINC"Unable to obtain new library information."))(GRTEXT -1 SQ&))(DEFUN S1&(S$j)(COMMAND"SHELL"S$j NIL))(DEFUN C:BLRESET()(SETQ S$Q NIL S%j NIL *ERROR* Sj)(SOQ)(C:BL))(DEFUN C:BLON()(SETQ S| T)(C:BL))(DEFUN C:BLOFF()(SETQ S| NIL)(C:BL))(DEFUN C:BLRESET()(SETQ S$Q NIL S%j NIL *ERROR* Sj)(SOQ))(DEFUN S|#(S$j)(SETQ *ERROR* Sj)(PRINC(STRCAT"\nError occured: "S$j))(REDRAW)(PRINC))(DEFUN C:BL(/ S&j S$j)(SETVAR"CMDECHO"0)(SETQ Sj *ERROR* *ERROR* S|#)(S?Q)(IF(= S$Q NIL)(S01))(WHILE(= S$Q NIL)(S#Q))(IF(NOT SQ&)(S#l""))(IF S%j(S1Q)(IF Sj&(S%l Sj&)))(SETQ Sll NIL S1l NIL S#1 NIL S0l NIL)(WHILE(AND(NOT Sll)(NOT S#1))(SETQ S#@ NIL)(IF S%j(WHILE(AND(NOT S#@)(NOT Sll)(NOT S#1))(SETQ S$j(S|Q"Block : "))(SQl S$j)(S@l S$j))(S$l))(IF(AND(NOT S#1)(< S#@ 100)(> S#@ 0))(S@1 S#@ T)(IF(= S#@ 0)(S?&))))(IF(NOT S#1)(REDRAW))(SETQ *ERROR* Sj)(PRINC))(GC)
  2.