home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 5.img / ACAD.LSP < prev    next >
Encoding:
Text File  |  1992-02-28  |  7.5 KB  |  194 lines
  1. (VMON)
  2.  
  3.    (setq fh78 0 fh65 0 fh72 0 fh85 0 fh70 370)
  4.    (setq bl (getvar "USERR1") blx (/ bl 100.0))
  5.    (setq d0 (* bl 10) d1 (* bl 15) d2 (* bl 43) d3 (* bl 47))
  6.    (setq d4 (* bl 15) d5 (* bl 25) d6 (* bl 35) d7 (* bl 51) d8 (* bl 37))
  7.    (setvar "ltscale" bl)
  8.    (setvar "DIMASZ" 0)
  9.    (setvar "DIMCEN" (* bl 2))
  10.    (setvar "DIMEXO" 0)
  11.    (setvar "DIMDLI" (* bl 10))
  12.    (setvar "DIMEXE" (* bl 2))
  13.    (setvar "DIMTXT" (* bl 3))
  14.    (setvar "DIMDLE" (* bl 2))
  15.    (setvar "DIMTIH" 0)
  16.    (setvar "DIMTOH" 0)
  17.    (setvar "DIMTAD" 1)
  18.    (setvar "DIMTIX" 1)
  19.    (setvar "DIMSOXD" 0)
  20.    (setvar "DIMTSZ" (* bl 0.8))
  21.  
  22. (defun C:TK (/ oer lw t1 t2 t3 t4 t5 t6 b1 b2 p1 a cd ths elv)
  23.    (setvar "CMDECHO" 0)
  24.    (setq ths (getvar "thickness"))
  25.    (setq elv (getvar "elevation"))
  26.    (setq oer *error* *error* tkerr)
  27.    (setq t1 1189.0 t2 841.0 t3 594.0 t4 419.0 t5 297.0 t6 209.0)
  28.    (setq lw 0.5 b1 25.0 b2 10.0)
  29.    (setq a (getstring "\n╩Σ╚δ═╝╓╜║┼ <A2>:"))
  30.    (if (eq a "") (setq a "A2"))
  31.    (blch)
  32.    (setq t1 (* t1 bl) t2 (* t2 bl) t3 (* t3 bl) t4 (* t4 bl) t5 (* t5 bl) t6 (* t6 bl))
  33.    (if (and (= (substr a 3 1) "+") (= (strlen a) 3)) (setq cd nil) (setq cd t))
  34.    (setq a (atoi (substr a 2 1)))
  35.    (if cd (progn
  36.           (cond ((= a 0) (setq p1 (list t1 t2)))
  37.                 ((= a 1) (setq p1 (list t2 t3)))
  38.                 ((= a 2) (setq p1 (list t3 t4)))
  39.                 ((= a 3) (setq p1 (list t4 t5) b2 5.0))
  40.                 ((= a 4) (setq p1 (list t6 t5) b2 5.0))
  41.           )
  42.           )
  43.        (progn
  44.        (cond ((= a 1) (setq p1 (list t1 t3)))
  45.              ((= a 2) (setq p1 (list t2 t4)))
  46.              ((= a 3) (setq p1 (list t3 t5) b2 5.0))
  47.              ((= a 4) (setq p1 (list t5 t5) b2 5.0))
  48.       )
  49.       )
  50.    )
  51.    (command "regen")
  52.    (setvar "elevation" 0)
  53.    (setvar "thickness" 0)
  54.    (drawline)
  55.    (setvar "elevation" elv)
  56.    (setvar "thickness" ths)
  57.    (setvar "cmdecho" 1)
  58.    (setq *error* oer)
  59.    (princ)
  60. )
  61.  
  62. (defun blch (/ x)
  63.    (princ "\n╩Σ╚δ═╝╓╜▒╚└² 1: <")
  64.    (princ (fix bl))
  65.    (setq x (getreal "> "))
  66.    (if x (setq bl x blx (/ bl 100)))
  67.    (setq d0 (* bl 10) d1 (* bl 15) d2 (* bl 43) d3 (* bl 47))
  68.    (setq d4 (* bl 15) d5 (* bl 25) d6 (* bl 35) d7 (* bl 51) d8 (* bl 37))
  69.    (setvar "USERR1" bl)
  70.    (setvar "ltscale" bl)
  71.    (setvar "DIMASZ" 0)
  72.    (setvar "DIMCEN" (* bl 2))
  73.    (setvar "DIMEXO" 0)
  74.    (setvar "DIMDLI" (* bl 10))
  75.    (setvar "DIMEXE" (* bl 2))
  76.    (setvar "DIMTXT" (* bl 3))
  77.    (setvar "DIMDLE" (* bl 2))
  78.    (setvar "DIMTIH" 0)
  79.    (setvar "DIMTOH" 0)
  80.    (setvar "DIMTAD" 1)
  81.    (setvar "DIMTIX" 1)
  82.    (setvar "DIMSOXD" 0)
  83.    (setvar "DIMTSZ" (* bl 0.8))
  84.    (princ)
  85. )
  86.  
  87. (defun drawline (/ ll lr ur ul ll0 lr0 ur0 ul0)
  88.    (setq b1 (* b1 bl) b2 (* b2 bl) lw (* lw bl))
  89.    (setq ll (list 0 0) lr (list (car p1) 0) ur p1 ul (list 0 (cadr p1)))
  90.    (setq ll0 (list b1 b2) lr0 (list (- (car p1) b2) b2) ur0 (list (- (car p1) b2) (- (cadr p1) b2)) ul0 (list b1 (- (cadr p1) b2)))
  91.    (command "limits" ll ur)
  92.    (command "zoom" "a")
  93.    (command "pline" ll "w" "0" "" lr ur ul "c")
  94.    (command "pline" ll0 "w" lw "" lr0 ur0 ul0 "c")
  95.    (command "layer" "m" "tk" "")
  96.    (command "insert" "acad00" lr0 blx "" "0")
  97.    (command "insert" "acad01" ul0 blx "" "0")
  98.    (command "layer" "s" "0" "")
  99. )
  100.  
  101. (defun ld(p1 p2 tp / oer)
  102.    (if (/= (+ fh78 fh65 fh72 fh85 fh70) 370) (tst))
  103.    (setvar "cmdecho" 0)
  104.    (setq oer *error* *error* tkerr)
  105.    (cond ((= tp 1) (if (null ldd1) (progn (ld2) (ld3) (gc) (setq ldd1 t ldd2 nil ldd3 nil))))
  106.          ((= tp 2) (if (null ldd2) (progn (ld1) (ld3) (gc) (setq ldd2 t ldd1 nil ldd3 nil))))
  107.          ((= tp 3) (if (null ldd3) (progn (ld1) (ld2) (gc) (setq ldd3 t ldd1 nil ldd2 nil))))
  108.    )  
  109.    (if (null p1) (progn (terpri) (prompt "╒²╘┌╫░╚δ│╠╨≥...╟δ╔╘║≥") (load (strcat "lisp\\" p2)) (princ)) (princ))
  110.    (setvar "cmdecho" 1)
  111.    (setq *error* oer)
  112.    (princ)
  113. )
  114.  
  115. (defun ld1() (setq c:othoax nil c:autoax nil othoax0 nil axerr nil a_f nil kjs nil ddd nil eee nil)
  116.              (setq combin nil chkerr nil dtr nil drw nil dr nil drwdim nil)
  117.              (setq drdim nil drwaxis nil draxis nil c:blip nil c:renum nil c:insnum nil c:grp nil)
  118.              (setq c:insaxis nil numerr nil wallerr nil chka nil inwin nil chkmc nil)
  119.              (setq c:pw nil c:iswin nil c:erwin nil c:chh nil c:erwin nil findent nil newst nil newnd nil spep nil entfind nil erpoly nil chherr nil erwinerr nil pwlerr nil iswinerr nil fixp nil arcfind nil)
  120.              (setq dv nil dv0 nil dim nil dimin nil cln nil geta nil getb nil sta nil)
  121.              (setq c:dimwall nil c:wall nil c:partywall nil c:mirr nil c:erwall nil)
  122.              (setq c:arcwall nil awerr nil achkmc nil dwaerr nil c:dwall nil)
  123.              (setq c:twall nil toperr nil c:ltopl nil ltoplsub nil atoplsub nil)
  124.              (setq c:plexpl nil experr nil c:inswin nil inwerr nil)
  125.              (setq inswin0 nil inswin1 nil inchkmc nil c:erawin nil erwerr nil)
  126.              (setq c:dirt nil c:fix nil c:calc nil c:mcb nil werr nil c:twin nil twerr nil c:txh nil txherr nil)
  127.              (setq c:lt nil c:lt0 nil c:lt1 nil lterr nil lt1 nil lt2 nil lt3 nil lt4 nil)
  128.              (setq sub11 nil sub22 nil c:ter nil ter1 nil ter2 nil ter3 nil ter4 nil)
  129.              (setq sub1 nil sub2 nil c:tj nil tjerr nil tj1 nil tj2 nil tj3 nil tj4 nil)
  130. )              
  131.  
  132. (defun ld2() (setq c:eelv nil c:selv nil c:welv nil c:nelv nil)
  133.              (setq eelerr nil selerr nil welerr nil nelerr nil)
  134.              (setq c:exw nil c:insw nil exwerr nil chkw nil defbox nil drawbox nil)
  135.              (setq c:nuer nil c:enuer nil nuerr nil dtr nil leierr nil)
  136.              (setq c:tje nil c:tjs nil c:yug nil c:leis nil c:leie nil)
  137.              (setq tjerr nil tje1 nil tje2 nil tje3 nil tje4 nil)
  138.              (setq c:emny nil c:mny nil mnyerr nil c:stair nil staerr nil)
  139.              (setq c:pao nil drl nil ban nil st nil jmw nil mmw nil pinput nil)
  140.              (setq lij nil licl nil licr nil lij2 nil lird nil liru nil)
  141.              (setq range nil sli nil smw nil aj nil mw1 nil paoerr nil)
  142.             (setq kx nil st nil lilr nil lidu nil asctof nil spl nil ph nil)
  143. )
  144.  
  145. (defun ld3() (setq c:cham nil chf nil chamerr nil c:fllet nil chf0 nil flleterr nil)
  146.              (setq c:corn nil chf0 nil cornerr nil c:proj nil projerr nil)
  147.              (setq c:3dst nil c:chkw nil chkwerr nil defbox nil drawbox nil)
  148.              (setq c:single nil c:dubble nil ltof nil ltof0 nil ltof1 nil)
  149.              (setq c:two nil c:rot nil twoerr nil c:extf nil c:trmf nil c:roof nil)
  150.           (setq c:opm nil c:ftol nil opmerr nil ftolerr nil)
  151. )   
  152.  
  153. (defun inblk(bx / bn oer loop)
  154.    (setvar "cmdecho" 0)
  155.    (setq oer *error* *error* tkerr)
  156.    (setq loop t)
  157.    (while loop
  158.    (setq bn (getstring "\n╩Σ╚δ┐Θ├√:"))
  159.    (if (or (findfile (strcat bn ".dwg")) (tblsearch "BLOCK" bn)) (setq loop nil) (princ "*╬┤╒╥╡╜*"))
  160.    )
  161.    (command "insert" bn "x" bx "y" bx)
  162.    (princ "\n▓σ╚δ╡π:")
  163.    (command pause)
  164.    (princ "\n╨²╫¬╜╟:")
  165.    (command pause)
  166.    (setvar "cmdecho" 1)
  167.    (setq *error* oer)
  168.    (princ)
  169. )
  170.  
  171.  
  172. (defun tkerr(s)
  173.    (if (/= s "Function cancelled")
  174.        (princ (strcat "Error:" s))
  175.    )
  176.    (command "layer" "s" "0" "")
  177.    (setvar "cmdecho" 1)
  178.    (setvar "highlight" 1)
  179.    (setvar "blipmode" 1)
  180.    (setq *error* oer)
  181.    (princ)
  182. )
  183.  
  184. (defun C:CL (/ i item)
  185.    (setq i 0)
  186.    (while (not (equal (setq item (nth i atomlist)) 'C:CL))
  187.       (if (= (type (eval item)) 'FILE)
  188.              (close (eval item)))
  189.              (setq i (1+ i))
  190.    )
  191.    (setq atomlist (member 'C:CL atomlist))
  192.    'DONE
  193. )
  194.